EnigmA Amiga Run 1997 April/EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso/EARCD/comm/mmgr/MM_StarTrack.lha/MM/Rexx/MM_StarTrack.rexx

OS/2 REXX Batch file | 1996-10-09 | 91KB | 3,785 lines

/*

                      $VER: MM_StarTrack 0.96  (09.10.96)

                           (C) 1994-96 Robert Hofmann

*/

parse arg opts

options cache
options failat 99
options results

signal on break_c
signal on break_d
signal on break_e
signal on break_f
signal on halt
signal on ioerr
signal on syntax

address 'MAILMANAGER'


Main:

    call Init
    call Header
    call Parse_Args(opts)
    call Get_SystemDatas()
    call Read_Cfg(0)
    call pragma('p', system.taskpri)
    call Wait_AreasWindow
    call Check_NodeList

    do n=0 to system.mtrx.count-1
        call Process_Msgs(system.mtrx.area.n, system.mtrx.addr.n)
    end

    if system.cse.count>1    then call Bounce_SplitEncoded

    call Clean_Up

call Quit(0, 'All done.')
exit


Add_CheckSplitEncoded: procedure Expose msg. system.

    parse arg areatag, nr, size

    last    = system.cse.count-1
    s            = 'a'x
    check    = upper(msg.data.from || s || msg.data.fromaddr || s || msg.data.to || s || msg.data.toaddr)

    if last>-1    then
        if system.cse.data.last~=check    then
            do
                system.cse.area.count    = 0
                system.cse.msg.count    = 0
                system.cse.data.count    = 0
            end

    MM_AddToStem 'system.cse.area'    'areatag'
    MM_AddToStem 'system.cse.msg'        'nr'
    MM_AddToStem 'system.cse.data'    'check'

    system.cse.count    = system.cse.area.count

return


Add_Clean: procedure Expose system.

    arg area

    if find(system.clean, area)>0 then return

    system.clean    = system.clean area

    MM_AddToStem 'system.clean' 'area'

return


Add_Clip: procedure

    arg area .

    tmp    = getclip('MM_EXPORT')

    if find(tmp, area)=0 then call setclip('MM_EXPORT', tmp area)

return


Add_Found: procedure Expose found. system.

    parse arg line

    if index(found.check, line'a'x)>0 then return 0

    MM_AddToStem 'found' 'line'

    found.check    = found.check line'a'x

return 0


Add_Kludge: procedure Expose msg. system. write.

    parse arg type, kludge

    stem.0    = 'msg.data.'
    stem.1    = 'write.'
    tmp            = '1'x || kludge

    MM_AddToStem stem.type'head' 'tmp'

return


Add_Log: procedure Expose msg. system.

    parse arg pfx.1, text.1, pfx.2, text.2

    if text.1='' & text.2~='' then
        do
            pfx.1        = pfx.2
            pfx.2     = ''
            text.1    = text.2
            text.2    = ''
        end

    if text.1~='' then
        do
            do n=1 to 2
                if pfx.n~='' then    pfx.n    = overlay(pfx.n, system.log.prefix)
                else                            pfx.n    = system.log.etypfx
            end

            text    = pfx.1 || text.1

            if text.2~='' then text = left(text, (system.log.linelen%2)-1) pfx.2 || text.2
        end

    MM_AddToStem 'msg.log' 'text'
return


Add_Stat: procedure Expose statistic.

    parse arg text, num .

    if num~='' then text = overlay('   'text' ', '   ......................:') right(num, 5)

    MM_AddToStem 'statistic' 'text'
return


Add_Status: procedure Expose msg.

    parse arg line

    MM_AddToStem 'msg.status' 'line'
return


Add_Via: procedure Expose msg. system.

    arg stem
    tmp    = '1'x'Via' system.addr delstr(date(), 8, 2)'  'time() '('system.prg.fid')'
    MM_AddToStem stem 'tmp'
return


Add_Write: procedure Expose write.

    parse arg text
    MM_AddToStem 'write.text' 'text'
return


Adjust_Addresses: procedure Expose domain. msg. system.

    from_addr    = Check_Addr(msg.data.fromaddr)
    to_addr        = Check_Addr(msg.data.toaddr  )
    adj                = 0

    if from_addr~=''    then
        if upper(msg.data.fromaddr)~=upper(from_addr) then
            do
                msg.data.fromaddr    = from_addr
                call Set_MsgChanged
            end

    if to_addr~=''        then
        if upper(msg.data.toaddr)~=upper(to_addr)            then
            do
                msg.data.toaddr        = to_addr
                call Set_MsgChanged
            end

return


Adjust_Kludges: procedure Expose msg. system.

    new.    = 0

    do n=0 to msg.data.head.count-1
        parse value upper(msg.data.head.n) with . 2 kludge .

        if find(system.rmkludges, kludge)=0 then MM_AddToStem 'new' 'msg.data.head.'n
    end

    if msg.data.head.count~=new.count then
        do
            call Drop_SubStem('msg.data.head')

            do n=0 to new.count-1
                msg.data.head.n    = new.n
            end

            msg.data.head.count    = new.count
        end

return


Analyse_Kludges: procedure Expose msg. domain. system.

    msg.data.kludge.reply    = Get_Kludge('MSGID:',    '1'x'REPLY:')
    msg.data.replyaddr        = Get_Kludge('REPLYADDR', 'To:')
    tmp                                        = Get_Kludge('REPLYTO')

    if tmp~='' then
        do
            parse var tmp check name
            address = Check_Addr(check)

            if address='' then break

            msg.data.fromaddr = address

            name = strip(name)
            if name~='' then msg.data.from = name
        end

    msg.data.kludges = 1

return


BaseName: procedure

    parse arg file

return substr(file, max(lastpos(':', file), lastpos('/', file))+1)


Both_Unknown: procedure Expose msg. system.

    parse arg area, nr

    call Log('   UNKKNOWN SOURCE & DESTINATION!!!')
    call Move_Msg(area, nr, system.badarea, 'Unknown source & destination')
    call Add_Status('SOURCE and DESTINATION-address unknown or incorrect, msg stopped!')
    call Count_Stat('UNKNDST')
    call Count_Stat('UNKNSRC')
return


Bounce_Mail: procedure Expose domain. msg. system.

    parse arg area, nr

    call Log('   UNKKNOWN DESTINATION!!!  From' msg.data.from 'to' msg.data.to)

    call Forward_Msg('Bounced', msg.data.fromlang, area, msg.data.from, msg.data.fromaddr,,
                                        Get_Text(msg.data.fromlang, 'SUBJ', 'BOUNCE_UNKNDST'),, 1)

    call Move_Msg(area, nr, system.badarea, 'Unknown destination')

    call Add_Status('Unknown DESTINATION-address detected:' msg.data.toaddr', *** BOUNCED ***')
    call Count_Stat('UNKNDST')
return


Bounce_SplitEncoded: procedure Expose domain. system.

    do n=0 to system.cse.count-1
        dmn        = Read_Msg(system.cse.area.n, system.cse.msg.n)
        last    = n-1

        call Add_Clean(system.cse.area.n)

        if system.cse.data.last~=system.cse.data.n    then
            do
                call Log(' Splitted encoded mails detected:' system.cse.area.n', starting at msg #'system.cse.msg.n)
                call Bounce_Twit('Split-Encoded', system.cse.area.n, system.cse.msg.n, domain.dmn.encoded.mode)

                move    = find(domain.dmn.encoded.mode, 'MOVE')>0

                call Count_Stat('ENCODED')
            end
        else
            if move then call Move_Msg(system.cse.area.n, system.cse.msg.n, system.badarea, 'Splitted Encoded Mail')
            else
                do
                    MM_DeleteMsg system.cse.area.n system.cse.msg.n
                    call Log('   Msg #' system.cse.msg.n 'deleted!')
                end

        call Log_Msg(dmn)
    end

return


Bounce_Twit: procedure Expose domain. msg. system.

    parse arg kind, area, nr, mode

    ukind = upper(kind)

    call Log('   'ukind 'MAIL!!!  From' msg.data.from 'to' msg.data.to)

    if find(mode, 'BOUNCE')>0 then
        do
            call Forward_Msg(kind, msg.data.fromlang, area, msg.data.from, msg.data.fromaddr,,
                                             Get_Text(msg.data.fromlang, 'SUBJ', 'BOUNCE_'compress(ukind, '-')),, 1)

            info    = '*** NETMAIL BOUNCED ***'
            ret        = 1
        end
    else
        do
            info    = ''
            ret        = 0
        end

    if find(mode, 'MOVE')>0 then call Move_Msg(area, nr, system.badarea, kind)
    else
        do
            MM_DeleteMsg area nr
            call Log('   Msg deleted!')
        end

    call Add_Status(ukind 'MAIL detected!!!' info)
    call Count_Stat(ukind)
return ret


break_c:; break_d:; break_e:; break_f:; halt:

    signal off break_c
    signal off break_d
    signal off break_e
    signal off break_f
    signal off halt

    return_code        =    5
    error_line    = 0
    error_msg            = 'Execution halted!!!'
    rc                        = 0
signal Exit


Check_Addr: procedure Expose domain. system.

    parse arg check, mode

    parse value strip(check, 'b', '. ') with zone ':' net '/' node '@' dmn '.' .
    parse var node node '.' point .

    if point='' then point = 0

    if ~datatype(zone, 'N') | ~datatype(net, 'N') | ~datatype(node, 'N') | ~datatype(point, 'N'),
     | zone=0 | net=0 then return ''

    if mode~='NOADJ' then
        do
            tmp = system.domain
            if domain='' | domain.tmp.adjust | mode='ADJUST' then dmn = Get_Domain(check)
        end
    else
        if dmn='' | find(system.vdomains, Make_Valid(dmn))=0  then return ''

return zone':'net'/'node'.'point'@'dmn


Check_Address: procedure Expose domain. msg. system.

    arg mode, addr . 1 zone . ':' .

    node    = mode'NODE'
    real    = mode'ADDR'
    tmp        = mode'DOMAIN'
    dmn        = msg.data.tmp

    if find(system.addresses, msg.data.node)>0 then
        return find(system.addresses system.nodes, upper(msg.data.real))=0

    if find(system.nodes, msg.data.node)>0 then return 0

    if domain.dmn.zones~='' & domain.dmn.bounce.wrongaddr then
        if find(domain.dmn.zones, zone)=0    | dmn=system.baddomain then return 1

    if ~domain.dmn.bounce.unkndst then return 0

    MM_GetNodelistNode msg.data.node 'tmp'; ret = rc

    if ret=0 then return 0
    if ret=5 then
        do
            call Log('*** INFO: Unable to access nodelist(s)!!!')
            return 0
        end

return 1


Check_AllowEncoded: procedure Expose domain. msg. system.

    parse arg dmn

    if ~domain.dmn.fkt.allowenc    then return 0

    enc.0 = 'FROM'
    enc.1    = 'TO'

    do n=0 to 1
        typ        = enc.n
        field    = typ'ADDR'

        do m=0 to domain.dmn.encoded.typ.count-1
            if Check_Pattern(domain.dmn.encoded.typ.m, msg.data.field) then return 1
        end
    end

return 0


Check_CrossNet: procedure Expose msg. domain.

    parse arg dmn

    if msg.data.fromdomain~=msg.data.todomain then return 1+domain.dmn.bounce.crossnet

return 0


Check_Empty: procedure Expose domain. msg. system.

    arg dmn, address

    if ~domain.dmn.delete.empty | ~msg.system    then return 0

    check = 0
    tear    = 0

    do n=0 to msg.data.text.count-1 while ~(check | tear)
        parse var msg.data.text.n first .

        tear    = first='---'
        check = strip(msg.data.text.n)~='' & ~tear
    end

return check=0


Check_Encoded: procedure Expose domain. msg. system.

    arg area, nr, dmn, msgsize

    if msg.system | msg.link            then return ''
    if domain.dmn.encoded.size=0    then return ''

    check_split    = find(domain.dmn.encoded.mode, 'SPLIT')>0

    if msgsize<domain.dmn.encoded.size & ~check_split    then return ''

    enc            = 0
    enc_len    = 0

    do n=msg.data.text.count-1 to 0 by -1
        len        = length(msg.data.text.n)
        check    = len-(len-length(compress(msg.data.text.n)))-lastpos(' ', msg.data.text.n)

        if last_len~=check then cnt = 0

        last_len = len

        if len<50    then iterate
        if cnt>0    then enc_len    = enc_len + last_len

        cnt    = cnt+1

        if cnt<max(domain.dmn.encoded.size%len, 10) then iterate

        enc = 1
        leave
    end

    if enc | (~enc & check_split)            then    allowed    = ~enc | Check_AllowEncoded(dmn)
    else                                                                        allowed    = 1

    if ~enc & ~allowed & check_split    then    call Add_CheckSplitEncoded(area, nr, enc_len)

    if allowed                                                then    ret         = ''
    else                                                                        ret            = '*' domain.dmn.encoded.mode

return ret


Check_FATT: procedure Expose msg. domain. rc. system.

    arg dmn

    if ~domain.dmn.fatt                                then return 0
    if find(msg.data.flags, 'FATT')=0 then return 0
    if msg.sysop                                            then return 1
    if msg.system | msg.link                    then return 2

return 3


Check_Function: procedure Expose domain. msg. rc. system.

    arg function

    ret    = Check_Matching_Pattern(function,    msg.data.from,    msg.data.fromaddr,    msg.data.subj),
                Check_Matching_Pattern(function,    msg.data.to,        msg.data.toaddr,        msg.data.subj)

return Set_RC(function, strip(ret))


Check_Hex: procedure

    arg hex hash ., len

return hex~='' & datatype(hex, 'X') & length(hex)=len & d2x(hash(hex))=hash


Check_Kill: procedure Expose msg. system.

    if ~system.fkt.kill | ~msg.sysop then return ''

return Check_Matching_Pattern('KILL', msg.data.from, msg.data.fromaddr, msg.data.subj)


Check_Loop: procedure Expose domain. msg. system.

    arg check, area, nr

    if ~check then return 0

    check.        = 0
    last_addr    = ''

    do n=0 to msg.data.foot.count-1
        if compress(msg.data.foot.n, '010D'x)='' then iterate

        addr = upper(Get_Addr_From_Via(msg.data.foot.n))

        select
            when addr='???'    then nop
            when check.addr    & last_addr~=addr & find(system.addresses, addr)>0 then return 1
            otherwise
                do
                    check.addr    = 1
                    last_addr        = addr
                end
        end
    end

return 0


Check_Matching_Pattern: procedure Expose msg. system.

    arg type, stem.name.0, stem.addr.0, stem.subj.0

    if system.fkt.np.type    then
        do n=0 to system.check.count-1
            field                            = system.check.n
            stem.field.count    = 1

            do m=0 to system.type.field.ptrn.count-1
                result.    = 0
                MM_SearchInStem 'stem.'field 'result' system.type.field.ptrn.m 'STR'

                if result.count>0 then return system.type.field.mode.m
            end
        end

    if system.fkt.fp.type    then
        do n=0 to system.ptrn.type.from.count-1
            cnt                    = 0
            stem.count    = 1

            do m=0 to system.full_check.count-1
                result.            = 0
                field                = system.full_check.m
                stem.0            = msg.data.field

                MM_SearchInStem 'stem' 'result' '"'system.ptrn.type.field.n'"' 'NUM'

                cnt    = cnt+(result.count>0)
            end

            if cnt=system.full_check.count then return system.ptrn.type.mode.n
        end

return ''


Check_NodeList: procedure Expose system.

    check    = Get_Node(system.addresses.0)
    tmp        = 'Unable to access nodelist(s)!!!'

    do n=0 to 5
        MM_GetNodelistNode check 'tmp'
        err = RC>0

        if ~err then leave

        call Log('*** WARNING:' tmp '('check 'not found)')
        call Log('             'n'> Waiting 30 seconds...')
        call delay(30*50)
    end

    if err then
        do
            if system.cplnl~=0 then
                do
                    call Log(' ==>> Compiling nodelists!')
                    call Command(system.cplnl)

                    MM_GetNodelistNode check 'tmp'
                    err = RC>0
                end

            if err then call Quit(24, tmp)
        end

return


Check_Pattern: procedure Expose result

    arg pattern, string.0

    string.count    = 1
    result.                = 0

    MM_SearchInStem 'string' 'result' '"'pattern'"' 'STR'

    result                = result.0

return result.count>0


Check_Processed: procedure Expose domain. system.

    /* If you disable this routine, you are not allowed to use MM_StarTrack anymore! */

    system.stat.ucnt    = system.stat.ucnt+1
    last_check                = system.stat.uchk
    system.stat.uchk    = 12+left(date('u'), 2)
    tmp               = date('i')-system.stat.uday

    if system.stat.uchk=last_check | tmp<30 | datatype(substr(system.prg.state, 2), 'N') then return

    call Msg_Head('4E6F74696669636174696F6E2061626F757420746865207573616765206F66'x system.prg.fid)
    call Get_SystemInfo()
    call Notify_Author('5573616765206F66'x system.prg.name)

return


Check_Robot: procedure Expose msg. system.

    if ~msg.sysop then return 0

    arg to

    do n=0 to system.robot.name.ptrn.count-1
        if Check_Pattern(system.robot.name.ptrn.n, to) then return 1
    end

return 0


Check_RRR: procedure Expose domain. msg. system.

    arg dmn

    if find(msg.data.flags, 'RRR')=0 then return 0

    if domain.dmn.rrr.system then
        if msg.sysop then return 1

    if domain.dmn.rrr.points then
        if find(system.addresses, upper(msg.data.tonode))>0    then return 1

return 0


Check_Twit: procedure Expose domain. msg. rc. system.

    if msg.sysop then return ''

return Check_Function('TWIT')


Clean_Up:

    if ~system.nostats & system.stats then call Write_Stats

    if system.export.count=0 & system.clean.count>0 then
        do n=0 to system.clean.count-1
            MM_CleanArea system.clean.n
        end

    do n=0 to system.export.count-1
        MM_Export            system.export.n
        MM_Delete            system.export.n
        MM_CleanArea  system.export.n
    end

    call delete(system.tmpfile)
return


Command: procedure Expose system.

    parse arg cmd

    address command cmd

    if rc>0 then call Log('*** ERROR: Command "'cmd'" returned' rc'.')
return rc


Count_Stat: procedure Expose system.

    arg mode ., cnt

    if cnt=''                                    then cnt                            = 1
    if system.stat.mode>65534 then system.stat.mode = 0

    system.stat.mode = system.stat.mode+cnt
return


Cross_Net: procedure Expose domain. msg. system.

    parse arg area, nr, mode, src

    call Log('   CROSSNET!!!')

    if mode<2 then
        do
            call Forward_Msg('CrossNet_ToDst', msg.data.tolang, area, msg.data.to, msg.data.toaddr,,
                                                Get_Text(msg.data.tolang, 'SUBJ', 'CROSSNET_TODST'),, 0)

            info    = 'Info added.'
        end
    else info = '*** BOUNCED ***'

    if ~src then
        do
            if mode<2 then tmp = 'CROSSNET_TOSRC'
            else                     tmp = 'BOUNCE_CROSSNET'

            call Forward_Msg('CrossNet_ToSrc', msg.data.fromlang, area, msg.data.from, msg.data.fromaddr,,
                                                Get_Text(msg.data.fromlang, 'SUBJ', tmp),, 1)

            resend = 'Msg resend.'
        end
    else resend = ''

    call Move_Msg(area, nr, system.badarea, 'Cross-Net')

    call Add_Status(strip('Crossnet-Netmail detected!' info resend))
    call Count_Stat('CROSSNET')
return


Cut_Text: procedure Expose msg.

    parse arg num

    tmp                                    = num+1
    msg.data.text.num        = '[...]'
    msg.data.text.tmp        = ''
    msg.data.text.count    = num+2

return


d2h: procedure

    arg num
return right(d2x(num), 4, '0')


Debug: procedure Expose system.

    if ~system.debug then return

    parse arg pfx, line

    if line~='' then line = 'DEBUG -' pfx':' line

    call Log(line, '*')

return


Del_Flag: procedure Expose msg.

    arg flag

    p    = find(msg.data.flags, flag)

    if p>0    then  msg.data.flags = delword(msg.data.flags, p, 1) '!'flag

return


Drop_SubStem:

    arg stem

    interpret "do nn=0 to" stem".count-1; drop" stem".nn; end;" stem".count = 0"
return


Execute_Cmd: procedure Expose msg. rc. system.

    parse arg area, nr

    call Get_FunctionDatas('EXECUTE')

    do n=0 to found.count-1
        cmd    = translate(found.n, '2227'x, 'FEFF'x)
        cmd    = Replace_Embedded(cmd)
        cmd    = Replace(cmd, area, '%a')
        cmd    = Replace(cmd, nr,   '%n')
        p        = pos('%T', cmd)

        if p>0 then
            do
                tmp_l =     left(cmd, p-1)
                tmp_r    = substr(cmd, p+2)

                parse var tmp_r msgfile tmp_r

                cmd    = strip(strip(tmp_l) strip(tmp_r))

                MM_WriteStem msgfile 'msg.data.head'
                MM_WriteStem msgfile 'msg.data.text' 'APPEND'
                MM_WriteStem msgfile 'msg.data.foot' 'APPEND'
            end

        call Log('   Executing "'cmd'".',, 3)

        ret = Command(cmd)

        select
            when ret=0    then    nop
            when ret=1    then    call Set_RC('KILL',            rc.kill 'BOUNCE MOVE')
            when ret=2    then    call Set_RC('TWIT',            rc.twit 'BOUNCE MOVE')
            otherwise                    call Set_RC('EXCLUDE',    '*')
        end
    end

return


Exit:

    if return_code>29 then call Report_Error(return_code, error, error_msg)

    select
        when return_code>=40 then error = 'INTERNAL-ERROR:'
        when return_code>=30 then error = 'IO-ERROR:'
        when return_code>=20 then error = 'ERROR:'
        when return_code>=10 then error = 'CFG-ERROR:'
        when return_code>=5  then error = 'INFO:'
        otherwise                                    error = ''
    end

    txt    = '***' strip(error error_msg) '***'

    if return_code>5 then    say system.prg.name':' txt

    call Log(,, 3)
    call Log(txt, '+')
    call Log(, '\', 3)

    call setclip('MM_LogPre', system.mm.logpre)

exit return_code


Format_Log: procedure Expose msg. system.

    parse arg pfx, text

    text    = strip(text)

    if text='' then
        do
            call Add_Log(pfx)
            return
        end

    if length(word(text, 1))>system.log.txtlen then
        do
            tmp        = substr(text, system.log.txtlen+1)
            text    = strip(left(text, system.log.txtlen))
            call         Add_Log(pfx, text)
            call         Format_Log('', tmp)
            return
        end

    tlen = length(text)

    if tlen>system.log.txtlen then
        do
            lsp        = lastpos(' ', text, system.log.txtlen)
            tmp        = substr(text, lsp)
            text    = strip(left(text, lsp-1))
            call        Add_Log(pfx,  text)
            call        Format_Log('', tmp)
        end
    else call        Add_Log(pfx,  text)

return


Forward: procedure Expose domain. msg. rc. system.

    parse arg mtrx, nr

    call Get_FunctionDatas('FORWARD')

    do n=0 to found.count-1
        parse value translate(found.n, '2227'x, 'FEFF'x) with to.area '¡' to.name '¡' to.addr '¡' to.subj '¡' to.flags '¡' delmsg

        if to.area='%ma'    then to.area    = mtrx

        call Log('   Forwarding mail from' msg.data.from 'to' to.area',' to.name || strip(',' to.addr, 't', ', ')'...')

        MM_GetAreaInfo to.area 'tmp'
        if tmp.type='MAIL' then    lang    = msg.data.tolang
        else                                        lang    = Get_Language(tmp.addr)

        call Forward_Msg('Forward', lang, to.area, strip(to.name), to.addr,,
                                            Replace_Embedded(strip(to.subj)), to.flags, 0)

        call Add_Clip(to.area)

        if delmsg    then
            do
                MM_DeleteMsg mtrx nr
                call Log('   -> Original msg deleted!')
            end
    end

return delmsg


Forward_Msg: procedure Expose domain. msg. system. write.

    parse arg file, language, area, dst, dstaddr, subject, flags, is_reply

    if file~='Forward' then
        do
            tmp = Get_Node(dstaddr)

            MM_GetNodelistNode tmp 'tmp'
            if RC~=0 then
                do
                    call Log('   *** Unknown destination-address' dstaddr', unable to forward mail!')
                    return
                end

            dst = Get_Sysop(dst, dstaddr)

            call Log('   Sending mail to' dst',' dstaddr,, 3)
        end

    subject        = Replace_Embedded(subject)
    textfile    = Read_File(file, language)

    write. = 0

    if is_reply then
        do
            if ~msg.data.kludges then call Analyse_Kludges
            if msg.data.replyaddr~='' then MM_AddToStem 'write.addtxt' 'msg.data.replyaddr'

            MM_AddToStem 'write.head' 'msg.data.kludge.reply'
        end

    do n=0 to txt.count-1
        tmp    = Replace_Embedded(txt.n)

        if index(tmp, '%T')=0 then call Add_Write(tmp)
        else
            do
                parse var tmp . '%T' lines .

                if lines='' | lines=msg.data.text.count then lines = msg.data.text.count
                else
                    do
                        if ~datatype(lines, 'N') then
                            do
                                lines = 20
                                call Log('*** WARNING: Numeric value expected after %T in' textfile 'at line' n'!!!')
                                call Log('             -> Using default (='lines') instead.',, 4)
                            end

                        call Cut_Text(lines)
                    end

                do m=0 to msg.data.head.count-1
                    tmp = strip(translate(msg.data.head.m, '@', '010D'x))
                    if tmp~='' then call Add_Write(tmp)
                end

                if msg.data.head.count>0 then call Add_Write()

                do m=0 to msg.data.text.count-1
                    call Add_Write(msg.data.text.m)
                end

                do m=0 to msg.data.foot.count-1
                    tmp = strip(translate(msg.data.foot.m, '@', '010D'x))
                    if tmp~='' then call Add_Write(tmp)
                end
            end
    end

    call Write_Msg('write', area, dst, dstaddr, subject, system.tmpfile, flags)
return


Get_Addr_From_Via: procedure Expose domain. system.

    parse arg . tmp

    tmp = compress(tmp, '010D'x',"')

    do while tmp>''
        parse var tmp check tmp
        address = Check_Addr(check)

        if address~='' then return address
    end

return '???'


Get_AddrDomain: procedure Expose system.

    arg .'@' domain '.' .

return Make_Valid(domain)


Get_Arg: procedure Expose args

    arg keyword, rnr

    p     = find(upper(args), keyword)
    ret    = 0

    if rnr>0 then
        if p>0 then
            do
                ret        = subword(args, p+1, rnr)
                args    = delword(args, p, p+rnr)
            end
        else ret            = ''
    else
        if p>0 then
            do
                ret        = 1
                args    = delword(args, p, 1)
            end

    args    = strip(args)

return ret


Get_Domain: procedure Expose domain. system.

    arg zone . ':' .

    l_tmp = system.domains
    u_tmp    = system.vdomains

    do while u_tmp~=''
        parse var l_tmp l_dmn l_tmp
        parse var u_tmp u_dmn u_tmp

        if find(domain.u_dmn.zones, zone)>0 then return l_dmn
    end

    parse var system.badaddr . '@' dmn '.' .

return dmn


Get_FunctionDatas: procedure Expose found. msg. system.

  parse arg function

    field.1            = 'FROM'
    field.2            = 'TO'
    found.            = 0
    found.check    = ''
    stem.subj.0    = msg.data.subj

    do i=1 to 2
        tmp                    = field.i
        tmp2                = tmp'ADDR'
        stem.name.0    =    msg.data.tmp
        stem.addr.0    = msg.data.tmp2

        do n=0 to system.check.count-1
            field                            = system.check.n
            stem.field.count    = 1

            do m=0 to system.function.field.ptrn.count-1
                result.    = 0
                MM_SearchInStem 'stem.'field 'result' system.function.field.ptrn.m 'STR'

                if result.count>0 then call Add_Found(system.function.field.mode.m)
            end
        end

        do n=0 to system.ptrn.function.from.count-1
            cnt                    = 0
            stem.count    = 1

            do m=0 to system.full_check.count-1
                result.            = 0
                field                = system.full_check.m
                stem.0            = msg.data.field

                MM_SearchInStem 'stem' 'result' '"'system.ptrn.function.field.n'"' 'NUM'

                cnt    = cnt+(result.count>0)
            end

            if cnt=system.full_check.count then cnt    = Add_Found(system.ptrn.function.mode.n)
        end
    end

return


Get_Kludge: procedure Expose msg. system.

    arg kludge, new_id

    result.     = 0
    result.0    = ''

    MM_SearchInStem 'msg.data.head' 'result' '"?'kludge' #?"' 'STR'

    parse var result.0 . ret

    ret = strip(ret)

    if ret~='' then ret = strip(new_id ret)

return ret


Get_Language: procedure Expose system.

    parse arg tmp_stem.0
    tmp_stem.count    = 1
    result.                    = 0

    do n=0 to system.lang.known.count-1
        tmp    = system.lang.known.n

        do m=0 to system.lang.ptrn.tmp.count-1
            MM_SearchInStem 'tmp_stem' 'result' system.lang.ptrn.tmp.m 'STR'
            if result.count>0 then return tmp
        end
    end

return ''


Get_Name: procedure

    parse arg address

    MM_GetNodelistNode address 'tmp'

    if rc>0 then    ret = 'Sysop'
    else                    ret = tmp.sysop

return ret


Get_Node: procedure

    parse arg left '.' . '@' right

return left'.0@'right


Get_Nodelists: procedure Expose system.

    system.nodelists = '<Nodelist not available>'

    if Command(system.shownl '>'system.tmpfile)>0 then return

    MM_ReadStem system.tmpfile 'tmp2'
    if rc>0 then return

    tmp.    = 0

    do n=1 to tmp2.count-1
        MM_AddToStem 'tmp' 'tmp2.'n
    end

    MM_SortStem 'tmp'

    system.nodelists = ''

    do n=0 to tmp.count-1
        system.nodelists    = system.nodelists strip(translate(tmp.n, ' ', '9'x))','
    end

    system.nodelists    = upper(strip(system.nodelists, 'b', ', '))

    call delete(system.tmpfile)
return


Get_Sysop: procedure

    parse arg name, address

    if index(address, '.0@')=0 then return name

return Get_Name(address)


Get_SystemDatas: procedure Expose system.

    MM_GetSysop        'system.sysop'
    parse var system.sysop system.sysop_first system.sysop_sur

    MM_GetNodes   'system.nodes'
    do n=0 to system.nodes.count-1
        system.nodes    = system.nodes system.nodes.n
    end
    upper system.nodes

    MM_GetAddrs                'system.addresses'
    MM_SortAddresses    'system.addresses'

    system.alldomains    = ''

    do n=0 to system.addresses.count-1
        system.addresses = system.addresses system.addresses.n

        tmp = Get_AddrDomain(system.addresses.n)
        if find(system.alldomains, tmp)=0 then system.alldomains    = system.alldomains tmp
    end
    upper system.addresses

    system.date    = translate(delstr(date(), 8, 2), '-', ' ')
    system.time = time()

return


Get_SystemInfo: procedure Expose system. write.

    /* If you disable this routine, you are not allowed to use MM_StarTrack anymore! */

    call Add_Write(' 'system.prg.info)
    call Add_Write()
    call Add_Write()
    call Add_Write('205379736F7020202020203A'x system.sysop)
    call Add_Write()
    call Add_Write('20416464726573736573203A'x system.addresses.count)
    call Add_Write('20446F6D61696E732020203A'x words(system.domains))
    call Add_Write('204D61696C6172656173203A'x system.mtrx.count '('system.mailareas.all')')
    call Add_Write()

    MM_ReadStem system.prg.stats 'write.text' 'APPEND'

    call Add_Write()
    call Add_Write()

    lst = '633A6C697374'x

    if exists(lst) then
        do
            call Command(lst system.prg.script'#?' '>'system.tmpfile)
            MM_ReadStem system.tmpfile 'write.text' 'APPEND'

            call Add_Write()
            call Add_Write()

            call Command(lst system.prg.cfgpath '>'system.tmpfile)
            MM_ReadStem system.tmpfile 'write.text' 'APPEND'

            call delete(system.tmpfile)
        end
    else
        do
            parse value statef(system.prg.script)'0 0 0 0 0' with . size . . date .
            call Add_Write(' 'left(system.prg.script, 40) right(size, 8)'   'date('n', date, 'i'))

            parse value statef(system.prg.cfg)'0 0 0 0 0' with . size . . date .
            call Add_Write(' 'left(system.prg.cfg, 40) right(size, 8)'   'date('n', date, 'i'))
        end

    call Add_Write()
    call Add_Write()
    call Add_Write(' 'system.prg.info)
    call Add_Write()
    call Add_Write()

return


Get_Text: procedure Expose msg. system.

    arg lang, typ, text

    if lang=''    then lang = 'DEFAULT'

    ret = system.txt.lang.typ.text
    if ret~=0 then return translate(ret, '2227'x, 'FEFF'x)

    cfg    = '#'typ'_'text

    call Log('*** WARNING: Unable to get' cfg 'of language' lang'!!!')
    call Log('             -> Using default instead.',, 4)

    ret = system.txt.default.typ.text
    if ret~=0 then return Replace_Embedded(translate(ret, '2227'x, 'FEFF'x))

    if lang='DEFAULT' then file = system.prg.txtpfx'/'
    else                                     file = system.prg.txtpfx'.'lang'/'

    call Log('*** CFG-ERROR: Unable to get' file'Misc:' cfg'!!!')

return '*** ERROR DETECTED ***'


Get_Version: procedure

    parse arg mode

    parse value sourceline(3-mode) with . . ver .
    parse var ver tst 'ß' .

    if ~datatype(strip(tst, 'b', '/ce '), 'N') then
        if ~mode then ver = Get_Version(1)
        else exit 99

return ver


Header:

    call Log(, '/', 3)
    call Log('***' system.prg.id '***', '+')
    call Log(system.prg.shortcr,, 3)
    call Log(,,3)

return


Make_Valid: procedure Expose system.

    arg string

return translate(string, system.replace, system.invalid)


Init:

    system.                            = 0

    MM_GetCfgPaths                'system.mm'
    MM_Version                        'system.mm'
    MM_GetTaskPri                    'system.taskpri'

    call                                     pragma('p', system.taskpri)
    call                                     pragma('w', 'NULL')

    system.path.cfg            = 'MM:Config'
    system.prg.ver            = Get_Version(0)
    system.prg.name            = 'MM_StarTrack'
    system.prg.cfgpath    = system.path.cfg'/'system.prg.name'/'
    system.prg.txtpfx        = system.prg.cfgpath'Texts'
    system.prg.id                = system.prg.name 'v'system.prg.ver
    system.prg.pfx            = system.prg.cfgpath || system.prg.name'.'
    system.prg.cfg            = system.prg.pfx'cfg'
    system.prg.shortcr    = '28432920313939342D393620526F6265727420486F666D616E6E'x
    system.prg.cr                = system.prg.shortcr '323A323439302F313031352E30404669646F4E6574'x
    system.prg.script        = 'MM:Rexx/'system.prg.name'.rexx'
    system.prg.stats        = system.prg.pfx'Statistics'
    system.mm.logpre      = getclip('MM_LogPre')
    system.prg.logpre     = system.mm.logpre'|'
    call                                        setclip('MM_LogPre', system.prg.logpre)
    system.prg.loglevel    = 2
    system.statistics     = 'CROSSNET EMPTY ENCODED EXCLUDE FATT KILL LOOP NTD PROCESSED RMPDST',
                                                'RMPSRC RRR SIZE TWIT UCHK UCNT UDAY UNKNDST UNKNSRC'
    system.statcnt            = words(system.statistics)*4
    system.tmpfile            = 'T:'system.prg.name'.tmp'
    system.invalid            = xrange('0'x, '@') || xrange('[', 'FF'x)
    system.replace            = copies('_', length(system.invalid))
    system.rmkludges        = '4D534749443A20444F4D41494E20494E544C20464D505420544F505420434852533A20434841525345543A'x
    system.log.linelen    = 80
    system.log.prelen        = 11
    system.log.txtlen        = system.log.linelen-system.log.prelen
    system.log.prefix   = copies('.', system.log.prelen-2)': '
    system.log.etypfx        = copies(' ', system.log.prelen)

    system.check.0                    = 'NAME'
    system.check.1                    = 'ADDR'
    system.check.2                = 'SUBJ'
    system.check.count            = 3
    system.full_check.0            = 'FROM'
    system.full_check.1            = 'FROMADDR'
    system.full_check.2            = 'TO'
    system.full_check.3            = 'TOADDR'
    system.full_check.4            = 'SUBJ'
    system.full_check.count    = 5

    call Include_Lib('rexxsupport')
return


Include_Lib: procedure Expose system.

    parse arg lib, prio
    if right(upper(lib), 8)~='.LIBRARY' then lib=lib'.library'
    if prio='' then prio=0

    if ~show('l', lib) then
        if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!')
return


Insert_Text: procedure Expose msg. system.

    parse arg file, language

    call Read_File(file, language)

    do n=0 to txt.count-1
        MM_AddToStem 'msg.data.addtxt' 'txt.'n
  end

return


IOerr:

    signal off ioerr

    return_code        = 30
    error_code        = rc
    error_line    = sigl
    error_msg            = 'IO-error' rc 'at line' error_line '['errortext(rc)']')
    rc                        = 0
signal Exit


Log: procedure Expose system.

    parse arg text, pre, level

    if ~datatype(level, 'N') then level = system.prg.loglevel

    tmp        = word('PRG MM', (pre~='')+1)
    text    = system.tmp.logpre || pre' 'text

    MM_WriteLog 'text' level
return


Log_Msg: procedure Expose domain. msg. system.

    arg dmn

    if domain.dmn.log.file=0 | pos('of' system.prg.name, msg.data.subj)>0 then return

    call Add_Log('Imported',    date()'  'time(),    'Created',        msg.data.datum msg.data.time)
    call Add_Log('From User',    msg.data.from,        'From Addr',    msg.data.fromaddr)
    call Add_Log('To   User',    msg.data.to,            'To   Addr',    msg.data.toaddr)

    if domain.dmn.log.size then msg_size    = msg.data.text.size 'bytes'
    else                                                msg_size    = ''

    if domain.dmn.log.flags then
        do
            msg_flags    = ''
            tmp                = msg.data.origflags

            do while tmp>''
                parse var tmp check tmp
                if find('PVT CRASH HOLD RRR FATT', check)=0 then iterate

                msg_flags = msg_flags check
            end

            msg_flags    = strip(msg_flags)

            if msg_flags=''    then msg_flags = '<none>'
        end
    else msg_flags = ''

    if domain.dmn.log.size | domain.dmn.log.flags then
        call Add_Log('Size', msg_size, 'Flags', msg_flags)

    if domain.dmn.log.subj then    call Format_Log('Subject', msg.data.subj)

    if domain.dmn.log.routing then
        do
            tmp        = msg.data.foot.count-1
            do tmp=tmp to 0 by -1 while strip(msg.data.foot.tmp, 'b', '010D'x' ')=''; end
            from  = Get_Addr_From_Via(msg.data.foot.tmp)

            if from='???' then
                if find(msg.data.origflags, 'CRASH')>0 then from = msg.data.fromaddr

            call Add_Log('Routing', 'from' from /* 'to' '???'*/ )
        end

    tmp.via    = 'Via'
    tmp.np    = '<no via-lines present>'

    if domain.dmn.log.via.all then
        if msg.data.foot.count=0 then call Add_Log(tmp.via, tmp.np)
        else
            do n=0 to msg.data.foot.count-1
                tmp.line    = subword(strip(msg.data.foot.n, 'b', '010D'x' '), 2)
                if tmp.line='' then iterate

                call Add_Log(tmp.via, tmp.line)
                tmp.via = ''
            end

    if domain.dmn.log.via.addr then
        if msg.data.foot.count=0 then call Add_Log(tmp.via, tmp.np)
        else
            do
                tmp = ''

                do n=0 to msg.data.foot.count-1
                    tmp.line    = strip(msg.data.foot.n, 'b', '010D'x' ')
                    if tmp.line='' then iterate

                    address = Get_Addr_From_Via(tmp.line)

                    if find(upper(tmp), upper(address))=0 then tmp    = tmp address
                end

                if tmp~='' then call Format_Log(tmp.via, strip(tmp))
            end

    call Format_Log('Status', msg.status.0)
    do n=1 to msg.status.count-1
        call Format_Log(, msg.status.n)
    end

    call Add_Log()
    call Add_Log()

    tmp    = domain.dmn.log.file
    if pos('%d', tmp)>0 then tmp = replace(tmp, translate(date('o'), '-', '/'), '%d')

    call Log('   Writing log "'tmp'".',, 4)

    MM_WriteStem tmp 'msg.log' 'APPEND'
    if rc>0 then call Log('*** WARNING: Unable to write file "'tmp'"!!!')

return


Msg_Head: procedure Expose system. write.

    parse arg text

    write. = 0

    call Add_Write()
    call Add_Write()
    call Add_Write(' 'text)
    call Add_Write(' 'copies('-', length(text)))
    call Add_Write()
    call Add_Write()

return


Move_File: procedure Expose system.

    parse arg from, to

    if exists(to)    then MM_MoveFile to to

    MM_MoveFile from to

    if RC=0    then call Log('   -> File "'from'" moved to "'to'".',, 3)
    else
        do
            call Log('*** IO-ERROR: Unable to move "'from"' to '"to'"!')
            to    = from
        end

return to


Move_FATT: procedure Expose domain. msg. rc. system.

    arg area, dmn, own

    tmp            = upper(msg.data.subj)
    subject    = Search_FATT(area, dmn, msg.data.subj, own)

    if rc.fatt>0    then    msg.data.subj    = strip(BaseName(subject) || left(' !', 2*own))
    else
        do
            call Forward_Msg('FATT-NotFound', msg.data.fromlang, area, msg.data.from,    msg.data.fromaddr,,
                                                Get_Text(msg.data.fromlang, 'SUBJ', 'FATT_NOTFOUND'),, 1)
            msg.data.subj    = subject
        end

    msg.changed        = max(msg.changed, tmp~=upper(msg.data.subj))

return


Move_Msg: procedure Expose system.

    parse arg old_area, nr, new_area, txt

    MM_ReadMsg  old_area nr 'tmp'

    tmp.flags    = tmp.flags 'HOLD SENT'

    if system.mm.release<445 then
        do
            tmp.file    = system.tmpfile

            if txt~='' then
                do
                    txt.count    = 3
                    txt.0            = ''
                    txt.1            = '*** BAD-REASON:' txt '***'
                    txt.2            = ''
                    mode            = 'APPEND'

                    MM_WriteStem tmp.file 'txt'
                end
            else mode = ''

            MM_WriteStem    tmp.file    'tmp.head'    mode
            MM_WriteStem    tmp.file    'tmp.text'    'APPEND'
            MM_WriteStem    tmp.file    'tmp.foot'    'APPEND'
            MM_WriteMsg        new_area    'tmp'
        end
    else
        do
            subjbak        = msg.subj
            tmp.flags    = tmp.flags '!IMP'

            if txt~=''    then    tmp.subj    = '['txt']' tmp.subj

            MM_EditMsg        old_area nr 'tmp'
            MM_MoveMsg        old_area nr new_area

            msg.subj    = subjbak
        end

    MM_DeleteMsg old_area nr

    call Log('   Moved old msg #'nr 'to' new_area'.',, 3)

return


Notify_Author: procedure Expose domain. msg. system. write.

    /* If you disable this routine, you are not allowed to use MM_StarTrack anymore! */

    parse arg subject

    a.0    = '526F6265727420486F666D616E6E'x
    a.1    = '33393A3137312F3130312E3140416D6967614E6574'x
    a.2    = '323A323439302F313031352E31404669646F4E6574'x

    select
        when pos('414D4947414E4554'x,    system.addresses)>0 then t = 1
        when pos('4649444F4E4554'x,        system.addresses)>0 then t = 2

        otherwise return
    end

    tmp = Get_AddrDomain(a.t)
    tmp = word('KILL', domain.tmp.delete.own=1)

    call Write_Msg('write', system.mtrx.area.0, a.0, a.t, subject, system.tmpfile, tmp)
return


Parse_Args: procedure Expose system.

    arg args

    system.forcecpl    = Get_Arg('CPLCFG', 0)

    if args~='' then signal Usage

return


Parse_MsgDatas: procedure Expose msg. system.

    arg mode

    parse var msg.data.from msg.data.from_first msg.data.from_sur
    parse var msg.data.to   msg.data.to_first   msg.data.to_sur

    msg.data.from_first    = strip(msg.data.from_first)
    msg.data.from_sur        = strip(msg.data.from_sur)
    msg.data.fromdomain    = Get_AddrDomain(msg.data.fromaddr)
    msg.data.fromlang        = Get_Language(msg.data.fromaddr)
    msg.data.fromnode        = upper(Get_Node(msg.data.fromaddr))
    msg.data.tonode            = upper(Get_Node(msg.data.toaddr  ))
    msg.data.to_first        = strip(msg.data.to_first)
    msg.data.to_sur            = strip(msg.data.to_sur)
    msg.data.todomain        = Get_AddrDomain(msg.data.toaddr)
    msg.data.tolang            = Get_Language(msg.data.toaddr)
    msg.data.u_toaddr        = upper(msg.data.toaddr)
    msg.link                        = find(system.nodes,     msg.data.u_toaddr)>0
    msg.sysop                        = find(system.addresses, msg.data.u_toaddr)>0
    msg.system                    = find(system.addresses, msg.data.tonode    )>0

    if msg.data.fromdomain=msg.data.todomain then    system.domain = msg.data.fromdomain

return


Path: procedure

    parse arg path .
    if right(path,1) ~= '/' & right(path,1) ~= ':' then path = path'/'
return path


Process_Msgs: procedure Expose domain. remap. system.

    parse arg area, system.addr

    call Log(' Checking mail-area "'area'"...',, 3)

    msgs.    = 0
    MM_SearchMsgs area 'msgs' '#?' '#?' '#?' 'IMP' '!SENT'

    if RC=4    then
        do
            call Log('*** ERROR: Unknown area "'area'"! ***',, 0)
            return
        end

    call Log(' ' msgs.count 'msgs to process.',, 3)

    if msgs.count=0 then return

    call Add_Clip(area)

    parse var system.addr . '@' system.domain .

    system.domain    = Make_Valid(system.domain)
    system.exp        = 1
    upper                        area

    if ~system.nostats & ~system.stats    then call Read_Stats
    if msgs.count>0                                            then call Add_Clean(area)

    do n=0 to msgs.count-1
        rc.            = 0    ;    rc.kill    = ''    ; rc.twit    = ''    ;    rc.encoded    = ''

        admn = Read_Msg(area, msgs.n)

        call Log('  Processing msg #'msgs.n 'from' msg.data.fromaddr 'to' msg.data.toaddr)
        call Count_Stat('PROCESSED')

        if Set_RC('ROBOT', Check_Robot(msg.data.to)) then
            do
                call Log('   Msg by' msg.data.from 'is for' msg.data.to', skipped.')
                call Count_Stat('NTD')
                iterate n
            end

        if Set_RC('EMPTY', Check_Empty(admn, msg.data.toaddr)) then
            do
                call Log('   Msg by' msg.data.from 'is empty, deleted.')
                MM_DeleteMsg area msgs.n
                call Count_Stat('EMPTY')
                iterate n
            end

        if Check_Function('EXECUTE')~=''    then call Execute_Cmd(area, msgs.n)

        if Check_Function('FORWARD')~=''    then
            if Forward(area, msgs.n)                then iterate

        select
            when Set_RC('KILL',            Check_Kill())~=''    then call Bounce_Twit('Kill',    area, msgs.n, rc.kill)

            when Set_RC('TWIT',            Check_Twit())~=''    then call Bounce_Twit('Twit',    area, msgs.n, rc.twit)

            when Set_RC('ENCODED',    Check_Encoded(area, msgs.n, admn, msg.data.text.size))~=''    then
                call Bounce_Twit('Encoded', area, msgs.n, rc.encoded)

            when Check_Function('EXCLUDE')~=''    then
                do
                    call Log('   Msg by' msg.data.from 'to' msg.data.to 'found in exclude-list, skipped.')
                    call Count_Stat('EXCLUDE')
                end

            otherwise
                do
                    call Set_RC('REMAPFROM',    Remap('FROM', msg.data.fromaddr,    msg.data.from,    area))
                    call Set_RC('REMAPTO',        Remap('TO',        msg.data.toaddr,        msg.data.to,        area))

                    if Set_RC('SRC',    Check_Address('FROM',    msg.data.fromaddr)) |,
                         Set_RC('DST',    Check_Address('TO',        msg.data.toaddr))    then
                            if system.nodelists=0 then call Get_Nodelists()

                    select
                        when rc.src & rc.dst    then call Both_Unknown(  area, msgs.n)
                        when rc.dst                        then call Bounce_Mail(   area, msgs.n)
                        when rc.src                        then call Unknown_Sender(area, msgs.n, rc.encoded)

                        when Set_RC('CROSSNET', Check_CrossNet(admn))>0 then
                            call Cross_Net(area, msgs.n, rc.crossnet, rc.src)

                        when Set_RC('LOOP', Check_Loop(domain.admn.loop, area, msgs.n)) then
                            call Stop_Loop(area, msgs.n, rc.src)

                        otherwise
                            do
                                if Set_RC('FATT',    Check_FATT(admn, msg.data.flags))=3 then
                                    call Stop_FATT(area, msgs.n, admn)

                                if Set_RC('RRR',    Check_RRR(admn)) then call Send_Receipt(area, msgs.n)

                                if ~msg.sysop then MM_AddToStem 'system.delete.'area 'msgs.'n

                                if rc.fatt>0    then
                                    do
                                        own    = rc.fatt=1

                                        if words(msg.data.subj)>1 then call Route_Multiple_FATT(area, admn, msg.data.subj, own)
                                        call Move_FATT(area, admn, own)
                                    end

                                call Log('   Msg ok.')

                                if rc.remapfrom+rc.remapto+rc.rrr+(rc.fatt~=3)=0 then call Count_Stat('NTD')

                                call Count_Stat('SIZE', (msg.data.text.size+512)%1024)
                            end
                    end

                    if msg.changed>0    then call Update_Msg(area, msgs.n)

                    msg.bad = (rc.crossnet>0 | rc.dst | rc.encoded~='' | rc.fatt=3 | rc.kill~='' | rc.loop | rc.src | rc.twit~='')

                    if domain.admn.log.all | (domain.admn.log.bad & msg.bad) then call Log_Msg(admn)

                    if domain.admn.delete.good & ~msg.bad    & rc.fatt~=3 then
                        do
                            tmp = msg.data.flags 'IMP KILL'
                            MM_EditMsgFlags area nr tmp
                        end

                    drop msg. rc.
            end
        end
    end

    if domain.admn.export & system.exp then MM_AddToStem 'system.export' 'area'
return


Quit:

    parse arg return_code, error_msg

    error_line    = 0
    rc                    = 0
signal Exit


Read_File: procedure Expose system. txt.

    parse arg file, language .

    lang.default    = system.prg.txtpfx'/'file
    lang.lang            = system.prg.txtpfx'.'language'/'file
    txt.                    = 0

    if language~='' then
        if ~exists(lang.lang) then
            do
                call Log('*** IO-ERROR: Unable to open "'lang.lang'"!!!')
                call Log('              -> Using default instead.',, 4)

                file    = lang.default
            end
        else file = lang.lang
    else file        = lang.default

    MM_ReadStem file 'txt'
    if rc>0 then
        do
            call Log('*** IO-ERROR: Unable to open "'file'"!!!')
            file = ''
        end

return file


Read_Msg: procedure Expose msg. domain. system.

    arg area, nr

    msg.    = 0

    MM_ReadMsg area nr 'msg.data'

    call Adjust_Addresses
    call Parse_MsgDatas('READMSG')

    parse var msg.data.date    msg.data.datum '  ' msg.data.time

    msg.data.datum            = translate(msg.data.datum, '-', ' ')
    msg.data.file                = ''
    msg.data.origflags    = msg.data.flags
    msg.error                        = ''
    msg.status.0                = 'Nothing to do, msg ok.'

    if msg.data.text.size=0 then
        do n=0 to msg.data.text.count-1
            msg.data.text.size    = msg.data.text.size+length(msg.data.text.n)
        end

return system.domain


Read_Stats: procedure Expose system.

    call Log('  Reading statistics...',, 4)

    parse value statef(system.prg.stats) with . . . . . . . desc
    desc    = strip(desc)

    if Check_Hex(desc, system.statcnt) then
        do
            tmp = system.statistics

            do while tmp~=''
                parse var tmp name tmp
                if name='' then iterate

                parse var desc 1 num 5 desc

                system.stat.name    = x2d(num)
            end
        end

    if system.stat.uday=0 then system.stat.uday = date(i)

    system.stats    = 1
return


Remap: procedure Expose domain. msg. remap. system.

    parse arg type, address, username, area

    if remap.type.count=0 then return 0

    old_addr    = address                ;    new_addr    = address
    old_name    = username             ;    new_name    = username
    dom                = type'DOMAIN'    ; dmn                = msg.data.dom
    remapped    = 0                            ; upper                address username

    do n=0 to remap.type.count-1 while ~remapped
        mode    = Remap_GetMode(remap.type.n.addr.old, remap.type.n.addr.new.dmn~='',,
                                                    remap.type.n.name.old, remap.type.n.name.new)

        select
            when mode=0 then iterate

            when mode=1 then
                if Check_Pattern(remap.type.n.name.old, new_name) then
                    new_name = remap.type.n.name.new

            when mode=2 then
                if Check_Pattern(Replace(remap.type.n.addr.old, '#?', '*'), new_addr)    then
                    do
                        new_addr = remap.type.n.addr.new.dmn

                        if pos('*', new_addr)>0 then
                            new_addr = Resolve_Wildcard(old_addr, remap.type.n.addr.old, new_addr)
                    end

            when mode=3 then
                if Check_Pattern(Replace(remap.type.n.addr.old, '#?', '*'), new_addr)    then
                    do
                        new_name = remap.type.n.name.new

                        if pos('*', new_addr)>0 then
                            new_addr = Resolve_Wildcard(old_addr, remap.type.n.addr.old, new_addr)
                    end

            when mode=4 then
                if Check_Pattern(remap.type.n.name.old, old_name) then
                    do
                        new_addr = remap.type.n.addr.new.dmn

                        if pos('*', new_addr)>0 then
                            new_addr = Resolve_Wildcard(old_addr, remap.type.n.addr.old, new_addr)

                        if remap.type.n.name.new~='' then new_name = remap.type.n.name.new
                    end

            when mode=5 then
                if Check_Pattern(Replace(remap.type.n.addr.old, '#?', '*'), old_addr)    &,
                Check_Pattern(remap.type.n.name.old, old_name) then
                    do
                        new_addr = remap.type.n.addr.new.dmn
                        new_name = remap.type.n.name.new

                        if pos('*', new_addr)>0 then
                            new_addr = Resolve_Wildcard(old_addr, remap.type.n.addr.old, new_addr)
                    end

            otherwise iterate
        end

        remapped    = upper(old_addr)~=upper(new_addr) | upper(old_name)~=upper(new_name)
    end

    if ~remapped then return 0

    if type='FROM' then
        do
            file    = 'Src'
            info    = 'SOURCE'
            reply    = 0
            stat    = 'SRC'
        end
    else
        do
            file  = 'Dst'
            info    = 'DESTINATION'
            stat    = 'DST'

            if find(system.addresses, upper(new_addr))>0 then
                do
                    call Del_Flag('DEL')
                    call Del_Flag('KILL')
                end
        end

    call Count_Stat('RMP'stat)

    info_old    = old_addr
    info_new    = new_addr

    if old_name~=new_name then
        do
            info_old    = old_name '%' info_old
            info_new    = new_name '%' info_new
        end

    if remap.type.n.flags='' then info_flags = ''
    else
        do
      info_flags            = strip(msg.data.flags)
            msg.data.flags    = remap.type.n.flags
        end

    adr                        = type'ADDR'
    lang                     = type'LANG'
    msg.data.adr    = new_addr
    msg.data.type    = new_name
    info                    = info'-address remapped from' info_old 'to' info_new

    call Parse_MsgDatas('REMAP')

    if remap.n.addinfo=1 then
        do
            call Read_File('Remap_'file, msg.data.lang)

            do n=0 to txt.count-1
                tmp    = Replace_Embedded(txt.n)
                tmp = Replace(tmp, info_new, '%n')
                tmp = Replace(tmp, info_old, '%o')
                MM_AddToStem 'msg.data.addtxt' 'tmp'
            end

            msg.changed    = 2
            info                = info', info added'
        end
    else
        if Get_AddrDomain(old_addr)=Get_AddrDomain(new_addr)    then call Set_MsgChanged
        else msg.changed = 2

    if remap.n.reply=1 then
        do
            call Read_File('Remap_Reply', msg.data.fromlang)

            write.    = 0

            do n=0 to txt.count-1
                tmp    = Replace_Embedded(txt.n)
                tmp = Replace(tmp, info_new, '%n')
                tmp = Replace(tmp, info_old, '%o')
                call    Add_Write(tmp)
            end

            sysop = Get_Sysop(msg.data.from, msg.data.fromaddr)
            txt   = Get_Text(msg.data.fromlang, 'SUBJ', 'REMAP_REPLY')

            call Write_Msg('write', area, sysop, msg.data.fromaddr, txt, system.tmpfile)

            info = info', sender notified'
        end

    info    = info'.'

    call Add_Status(info)
    call Log(  '   'info)

    if info_flags~='' then
        do
            info_flags    = 'Flags changed from "'info_flags'" to "'msg.data.flags'".'

            call Log(  '   'info_flags)
            call Add_Status(info_flags)
        end

return 1


Remap_GetMode: procedure Expose system.

    parse arg oa, na, on, nn

    oa    = oa~=''; on    = on~=''; nn    = nn~=''

    if ~oa & na=0 &  on &  nn then return 1
    if  oa & na=1 & ~on & ~nn then return 2
  if  oa & na=0 &  on &  nn then return 3
  if ~oa & na>0 &  on       then return 4
  if  oa & na=1 &  on &  nn then return 5

return 0


Replace: procedure

    parse arg string, new, old

    do while index(string, old)~=0
        interpret "parse var string l '"old"' r"
        string = l || new || r
    end

return string



Replace_Embedded: procedure Expose msg. system.

    parse arg text

    if pos('%', text)=0 then return text

    text    = replace(text, msg.data.datum,                '%cd')
    text    = replace(text, msg.data.time,                '%ct')
    text    = replace(text, msg.data.fromaddr,        '%fa')
    text    = replace(text, msg.data.from_first,    '%ff')
    text    = replace(text, msg.data.from_sur,        '%fs')
    text    = replace(text, msg.data.from,                '%f' )
    text    = replace(text, msg.data.flags,                '%F' )
    text    = replace(text, system.date,                    '%id')
    text    = replace(text, system.time,                    '%it')
    text    = replace(text, system.nodelists,            '%nl')
    text    = replace(text, system.addr,                    '%sa')
    text    = replace(text, system.sysop_first,        '%sf')
    text    = replace(text, system.sysop_sur,            '%ss')
    text    = replace(text, system.sysop,                    '%s' )
    text    = replace(text, msg.data.subj,                '%S' )
    text    = replace(text, msg.data.toaddr,            '%ta')
    text    = replace(text, msg.data.to_first,        '%tf')
    text    = replace(text, msg.data.to_sur,            '%ts')
    text    = replace(text, msg.data.to,                    '%t' )

return text


Report_Error:

    /* If you disable this routine, you are not allowed to use MM_StarTrack anymore! */

    signal off break_c
    signal off break_d
    signal off break_e
    signal off break_f
    signal off halt
    signal off ioerr
    signal off syntax

    call Log(' An internal error happened! Error-analysis started!',, 0)

    call Msg_Head('4E6F74696669636174696F6E2061626F757420616E206572726F72206F66'x system.prg.id)
    call Add_Write('202A2A2A'x error_msg '2A2A2A'x)
    call Add_Write()
    call Add_Write(' 'right(error_line, 4, '0')':' strip(translate(sourceline(error_line), ' ', '9'x)))
    call Add_Write()
    call Add_Write()
    call Add_Write()

    call Get_SystemInfo()

    call delete(system.tmpfile)

    address command

    ver    = 'version >>'system.tmpfile 'full'
    ver
    ver '726578787379736C69622E6C696272617279'x
    ver '72657878737570706F72742E6C696272617279'x
    ver '72657878686F73742E6C696272617279'x
    ver '7379733A73797374656D2F726578786D617374'x
    ver    '6D75696D61737465722E6C696272617279'x

    address 'MAILMANAGER'

    MM_ReadStem system.tmpfile 'write.text' 'APPEND'

    call Add_Write()

    if msg.data.from~='MSG.DATA.FROM' then
        do
            call Add_Write()
            call Add_Write(' MSG.DATA.FROM       = "'msg.data.from'"')
            call Add_Write(' MSG.DATA.FROMADDR   = "'msg.data.fromaddr'"')
            call Add_Write(' MSG.DATA.TO         = "'msg.data.to'"')
            call Add_Write(' MSG.DATA.TOADDR     = "'msg.data.toaddr'"')
            call Add_Write(' MSG.DATA.SUBJ       = "'msg.data.subj'"')
            call Add_Write(' MSG.DATA.DATE       = "'msg.data.date'"')
            call Add_Write(' MSG.DATA.FLAGS      = "'msg.data.flags'"')
            call Add_Write(' MSG.DATA.HEAD.COUNT = "'msg.data.head.count'"')
            call Add_Write(' MSG.DATA.TEXT.COUNT = "'msg.data.text.count'"')
            call Add_Write(' MSG.DATA.FOOT.COUNT = "'msg.data.foot.count'"')
            call Add_Write()
        end

    call Add_Write()

    MM_ReadStem system.prg.cfg 'write.text' 'APPEND'

    tmp = '633A6C697374'x

    if exists(tmp) then
        do
            address command tmp '>'system.tmpfile system.prg.cfgpath 'dates'
            tmp = rc

            call Add_Write()

            MM_ReadStem system.tmpfile 'write' 'APPEND'
            call delete(system.tmpfile)

            if tmp~=0 then call Add_Write('RC =' tmp)
        end

    call Add_Write()
    call Add_Write()

    call Notify_Author('4572726F722D5265706F7274206F66'x system.prg.name)
return


Request_Choice: procedure Expose system.

    parse arg text, buttons, ret_vals

    title    = system.prg.name'-Requester'
    text    = translate(Replace(text, '0A'x, '\n'), '1b'x, '\')

    if length(text)<40 then text = center(text, 40)

    MM_Requester title 'text' 'buttons'

    if rc=0 then rc=words(ret_vals)

return compress(word(ret_vals, rc), '_')


Resolve_Wildcard: procedure

    parse arg address, from, to

    parse var address a.1 ':' a.2 '/' a.3 '.' a.4 '@' a.5
    parse var from        f.1 ':' f.2 '/' f.3 '.' f.4 '@' f.5
    parse var to            t.1 ':' t.2 '/' t.3 '.' t.4 '@' t.5

    do n=1 to 5
        wposf    = pos('*', f.n)
        wpost    = pos('*', t.n)

        select
            when wposf=0 & wpost=0    then r.n = t.n
            when wposf>0 & wpost=0    then r.n = f.n
            when wposf>0 & wpost>0    then
                do
                    dpos    = compare(f.n, t.n)

                    if dpos=0    then tmp = ''
                    else                     tmp = substr(t.n, dpos, wpost-dpos)

                    r.n        = left(f.n, max(dpos-1, 0)) || tmp || substr(a.n, wposf)
                end
            otherwise
                do
                    call Log('*** WILDCARD-ERROR: Unable to resolve' f.n '->' t.n '('from '->' to')')
                    call Log('                    Remap NOT possible!', 3)

                    do m=1 to 5
                        r.m = a.m
                    end

                    leave n
                end
        end
    end

return r.1':'r.2'/'r.3'.'r.4'@'r.5


Route_Multiple_FATT: procedure Expose domain. msg. msgs. rc. system.

    parse arg area, admn, first_file additional_files, own

    call Log('   Multiple FATT detected, writing additional msgs...')

    call Read_File('FATT-Multiple', msg.data.tolang)

  file_bak                = msg.data.file
    flags_bak                = msg.data.flags
    msg.data.file        = system.tmpfile'2'

    if domain.admn.delete.own    then msg.data.flags = msg.data.flags 'KILL'

    do n=0 to txt.count-1
        txt.n    = Replace_Embedded(txt.n)
    end

    MM_AddToStem        'txt'                    'system.prg.tearline'
    MM_WriteStem        msg.data.file    'txt'

    do while additional_files~=''
        parse var additional_files filename additional_files
        if filename='' then iterate

        if ~own then call Log('   -> Generating new msg for "'filename'".')

        msg.data.subj    = filename
        call Move_FATT(area, admn, own)

        if ~own then MM_WriteMsg area 'msg.data'
    end

    call delete(msg.data.file)

    msg.data.file        = file_bak
    msg.data.flags    = flags_bak
    msg.data.subj        = first_file
    msg.changed            = max(msg.changed, 1)

return


Search_FATT: procedure Expose domain. msg. rc. system.

    parse arg area, dmn, name, own
    upper dmn

    if own & domain.dmn.fatt.ownpath~=''    then    mailpath    = domain.dmn.fatt.ownpath
    else
        do
            tmp                    = Make_Valid(area)
            mailpath        = system.mtrx.path.tmp
        end

    check.        = 0
    MM_AddToStem 'check' 'mailpath'
    MM_AddToStem 'check' 'system.mm.inbound'
    MM_AddToStem 'check' 'system.mm.baddir'
    MM_AddToStem 'check' 'system.badpath'

    name    = BaseName(name)

    if domain.dmn.fatt.adjust & pos(',', name)>0 then parse var name name ',' ext

    found = 0

    do n=0 to check.count-1 while ~found
        path    = check.n
        file    = path || name
        found    = exists(file)

        if ~domain.dmn.fatt.adjust then iterate

        call Command('c:list >'system.tmpfile file',#? lformat "%p%n"')
        MM_ReadStem system.tmpfile 'list'

        if list.count>0 & exists(list.0) then
            do
                do m=0+(~found) to list.count-1
                    call Log('   -> Deleting "'list.m'"...',, 4)
                    call delete(list.m)
                end

                if found                                    then break

                if rename(list.0, file)    then call Log('   -> "'list.0'" renamed to "'file'".',, 3)
                else
                    do
                        call Log('*** IO-ERROR: Unable to rename "'list.0'" to "'file'"!')

                        file    = list.0
                        name    = BaseName(file)
                    end

                found    = 1
            end
    end

    call delete(system.tmpfile)

    if found    then
        do
            if upper(path)~=upper(mailpath) then file = Move_File(file, mailpath || name)

            parse value statef(file)'FF'x' ?' with . msg.fatt.size . . . . . desc 'FF'x .
            desc    = 'FATT: From' msg.data.fromaddr 'to' msg.data.toaddr';' desc

            MM_SetFilenote file 'desc'
        end
    else
        do
            call Log('   -> Unable to locate file "'name'"!!!')

            file                = Replace_Embedded(replace(Get_Text(msg.data.tolang, 'SUBJ', 'NOFATT'), name, '%fatt'))
            rc.fatt            = 0
            rc.was_fatt    = 1
            call                    Del_Flag('FATT')
        end

return file


Send_Receipt: procedure Expose domain. msg. system.

    parse arg area, nr

    call Log('   SENDING RECEIPT!!!')

    call Forward_Msg('ReturnReceiptRequest', msg.data.fromlang, area, msg.data.from,,
                    msg.data.fromaddr, Get_Text(msg.data.fromlang, 'SUBJ', 'RRR'),, 1)

    call Add_Status('Returned Receipt-Request.')
    call Count_Stat('RRR')
return


Set_MsgChanged: procedure Expose msg. system.

    msg.changed    = max(msg.changed, 1+(system.mm.release<421))

return


Set_RC: procedure Expose rc. system.

    parse arg type, ret

    if rc.type~='' & rc.type~=0    then
        if datatype(rc.type, 'N')    then    rc.type = max(rc.type,    ret)
        else                                                        rc.type = strip(rc.type ret)
    else                                                            rc.type    = ret

    call Debug('RC', type':' rc.type)

return rc.type


Stop_FATT: procedure Expose msg. domain. system. rc.

    arg area, nr, dmn

    call Log('   FILEATTACH!!! From' msg.data.from 'to' msg.data.to)

    msg.data.subj    = BaseName(strip(msg.data.subj))
    fatt.file            = Search_FATT(area, dmn, msg.data.subj, 0)

    if rc.fatt=0    then return

    notify            = domain.dmn.fatt.notify
    found                = 0
    rc.fatt            = 0
    rc.was_fatt    = 1
    call                    Del_Flag('FATT')

    select
        when domain.dmn.fatt.hold then
            do
                notify_txt    = 'put on hold'

                msg.data.subj    = msg.data.subj',' msg.fatt.size 'bytes'

                parse var msg.data.toaddr zone ':' net '/' node '.' point '@' .

                flow = system.mm.outbound || zone'.'net'.'node'.'point'.HLO'
                open = 1

                if ~open(out, flow, a) then
                    if ~open(out, flow, w) then
                        if ~open(out, flow'_TMP', a) then
                            if ~open(out, flow'_TMP', w) then
                                do
                                    call Log('*** IO-ERROR: Unable to create flow-file' flow'!!!')
                                    open        = 0
                                    notify    = 0
                                end

                if open then
                    do
                        call writeln(out, '^'fatt.file)
                        call   close(out)

                        call Log('   -> File' fatt.file 'was put on hold for' msg.data.toaddr'.')
                    end
            end

        when domain.dmn.fatt.bad then
            do
                notify_txt    = 'moved to the #BADDIR'
                fatt.file        = Move_File(fatt.file, system.mm.baddir || BaseName(fatt.file))
            end

        otherwise
            do
                notify_txt    = 'deleted'

                if delete(fatt.file) then    call Log('   -> File' fatt.file 'was deleted.')
                else                                            call Log('*** IO-ERROR: Unable to delete "'fatt.file'"!')
            end
    end

    if notify then
        do
            tmp = word('Killed Hold', domain.dmn.fatt.hold+1)

            call Insert_Text('FATT-'tmp'_ToDst', msg.data.tolang  )
            call Read_File(  'FATT-'tmp'_ToSrc', msg.data.fromlang)

            write.    = 0
            do n=0 to txt.count-1
                call Add_Write(Replace_Embedded(txt.n))
            end

            sysop = Get_Sysop(msg.data.from, msg.data.fromaddr)
            txt   = Get_Text(msg.data.fromlang, 'SUBJ', 'FATT_TOSRC')

            call Write_Msg('write', area, sysop, msg.data.fromaddr, txt, system.tmpfile)

            info = 'File was' notify_txt', source & destination were notified.'
        end
    else info = ''

    call Add_Status('FILEATTACH stopped!!!' info)
    call Count_Stat('FATT')

return


Stop_Loop: procedure Expose domain. msg. system.

    parse arg area, nr, src

    call Log('   NETMAIL-LOOP!!!')

    tmp            = msg.data.foot.count-1
    dstaddr    = Get_Addr_From_Via(msg.data.foot.tmp)

    if dstaddr='???' then dstaddr = msg.data.toaddr

    dstname    = Get_Name(         dstaddr)
    dstlang    = Get_Language(dstaddr)

    if dstaddr~=msg.data.toaddr & dstname~=msg.data.to then
        do
            if ~msg.system then
                do
                    flg = 'CRASH'
                    txt    = flg'ED'
                end
            else
                do
                    flg = ''
                    txt    = 'SENT'
                end

            call Forward_Msg('Loop_ToDst', msg.data.tolang, area, msg.data.to, msg.data.toaddr,,
                                                Get_Text(msg.data.tolang, 'SUBJ', 'LOOP_TODST'), flg, 0)

            msg.data.text.0            = ''
            msg.data.text.1            = '[...]'
            msg.data.text.2            = ''
            msg.data.text.count = 3
            crashed                            = '***' txt 'TO DESTINATION *** '
        end
    else crashed = ''

    call Forward_Msg('Loop_ToLink', dstlang, area, dstname, dstaddr,,
                                        Get_Text(Get_Language(dstaddr), 'SUBJ', 'LOOP_TOLINK'),, 0)

    if ~src then
        do
            call Forward_Msg('Loop_ToSrc', msg.data.fromlang, area, msg.data.from, msg.data.fromaddr,,
                                                Get_Text(msg.data.fromlang, 'SUBJ', 'LOOP_TOSRC'),, 1)

            resend = 'Msg resend.'
        end
    else resend = ''

    call Move_Msg(area, nr, system.badarea, 'Loop-mail')

    call Add_Status(strip('Netmail-loop detected! 'crashed || resend))
    call Count_Stat('LOOP')
return 1


Syntax:

    signal off syntax

    return_code        = 40
    error_code        = rc
    error_line        = sigl
    error_msg            = 'Error' rc 'at line' error_line '['errortext(rc)']'
    rc                        = 0
signal Exit


Unknown_Sender: procedure Expose domain. msg. system.

    parse arg area, nr, encoded

    if encoded~='' then call Cut_Text(10)

    call Log('   UNKNOWN SENDER!!!')

    call Forward_Msg('Unknown_Source', msg.data.tolang, area, msg.data.to, msg.data.toaddr,,
                                        Get_Text(msg.data.tolang, 'SUBJ', 'UNKNSRC'),, 0)

    call Move_Msg(area, nr, system.badarea, 'Unknown sender')

    call Add_Status('Unknown SOURCE-address detected:' msg.data.fromaddr', msg forwarded.')
    call Count_Stat('UNKNSRC')
return


Update_Msg: procedure Expose msg. system.

    parse arg area, nr

    if msg.changed=2    then
        do
            call Adjust_Kludges()
            call Add_Kludge(0, 'ORIGDATE:' msg.data.date)

            msg.data.file        = system.tmpfile
            msg.data.flags    = msg.data.flags 'IMP'

            call Write_Msg_File('msg.data', system.tmpfile, 0, 1)
        end

    MM_EditMsg area nr 'msg.data'

    if msg.changed=2 then call delete(system.tmpfile)
return


Usage:

    say
    say 'Usage: [RX] MM_StarTrack[.rexx] [CPLCFG]'
    say

call Quit(0, 'Usage requested')


Wait_AreasWindow: procedure Expose system.

    MM_AreasWin
    if rc=0 then return

    bell    = '07'x
    cr        = '0D'x

    call Request_Choice('\c\n\1'system.prg.id'\0 is waiting.\n\nPlease go back to the Areas-Window',
                                            'as soon as possible!\n', '* _WAIT ', '_')

    tmp        = 'Waiting for Areas-Window...'
    call writech(STDOUT, bell || tmp || cr)
    call Log(tmp,, 4)

    rc    = 1

    do while rc~=0
        MM_AreasWin

        call writech(STDOUT, bell)
        call Delay(250)
    end

return


Write_Msg: procedure Expose domain. msg. system. write.

    starmsg. = 0
    parse arg stem, area, starmsg.data.to, starmsg.data.toaddr, starmsg.data.subj, starmsg.data.file, starmsg.data.flags

    MM_GetAreaInfo area 'ainfo'
    is_matrix    = ainfo.type='MAIL'

    if is_matrix then
        do
            tmp = Check_Addr(starmsg.data.toaddr, 'ADJUST')
            MM_GetNearestAddr tmp 'tmp_addr'
            if rc~=0 then tmp_addr = system.addresses.0

            tmp                                        = Get_AddrDomain(tmp_addr)
            starmsg.data.fromaddr    = domain.tmp.replyaddr

            if starmsg.data.fromaddr=0    then starmsg.data.fromaddr = tmp_addr
        end
    else
        do
            starmsg.data.tear        = system.prg.fid
            starmsg.data.origin    = translate(system.prg.cr, '[]', '()')
        end

    starmsg.data.from    = system.prg.fid

    if domain.tmp.delete.own=1    then
        if find(starmsg.data.flags, 'KILL')=0 then starmsg.data.flags = starmsg.data.flags 'KILL'

    call Add_Kludge(1, 'ROBOTMAIL')

    call Write_Msg_File(stem, starmsg.data.file, is_matrix, is_matrix)

    MM_WriteMsg area 'starmsg.data'
    if rc>0 then call Log('*** MM-ERROR: Unable to write a new msg in' area'!!!')

    call delete(starmsg.data.file)

    drop starmsg. write.
return


Write_Msg_File: procedure Expose msg. system. write.

    parse arg stem, file, tear, via

    if tear    then MM_AddToStem stem'.text' 'system.prg.tearline'
    if via    then call Add_Via(stem'.foot')

    MM_WriteStem file stem'.head'                            ; ret = rc
    MM_WriteStem file stem'.addtxt'    'APPEND'    ; ret = ret+abs(rc)
    MM_WriteStem file stem'.text'      'APPEND'    ; ret = ret+abs(rc)
    MM_WriteStem file stem'.foot'        'APPEND'    ; ret = ret+abs(rc)

    if ret>0 then call Log('*** IO-ERROR: Troubles while writing file "'file'"!!!')

return


Write_Stats: procedure Expose domain. system.

    call Check_Processed
    call Log(' Writing statistics...',, 4)

    line                = '   'copies('-', 30)
    statistic.    = 0
    tmp                    = 'Netmail-Statistics of' system.prg.id':'
    total.err        = system.stat.crossnet+system.stat.empty+system.stat.encoded+system.stat.exclude,
                                +system.stat.kill+system.stat.loop+system.stat.twit+system.stat.unkndst,
                                +system.stat.unknsrc
    total.ok        = system.stat.ntd+system.stat.rmpsrc+system.stat.rmpdst+system.stat.rrr

    call Add_Stat()
    call Add_Stat()
    call Add_Stat(' 'tmp)
    call Add_Stat(' 'copies('=', length(tmp)))
    call Add_Stat('   (since' translate(date('n', system.stat.uday, 'i'),'-', ' ')')')
    call Add_Stat()
    call Add_Stat()
    call Add_Stat('CrossNet mails',                    system.stat.crossnet)
    call Add_Stat('Empty mails',                        system.stat.empty)
    call Add_Stat('Encoded mails',                    system.stat.encoded)
    call Add_Stat('Excluded mails',                    system.stat.exclude)
    call Add_Stat('Fileattaches',                        system.stat.fatt)
    call Add_Stat('Killed mails',                        system.stat.kill)
    call Add_Stat('Loop mails',                            system.stat.loop)
    call Add_Stat('Twitted mails',                    system.stat.twit)
    call Add_Stat('Unknown destinations',        system.stat.unkndst)
    call Add_Stat('Unknown senders',                system.stat.unknsrc)
    call Add_Stat(line)
    call Add_Stat('Mails with errors etc',    total.err)
    call Add_Stat()
    call Add_Stat()
    call Add_Stat('Remapped source-addr',        system.stat.rmpsrc)
    call Add_Stat('Remapped dest.-addr',        system.stat.rmpdst)
    call Add_Stat("Returned receipt's",            system.stat.rrr)
    call Add_Stat('Nothing to do',                    system.stat.ntd)
    call Add_Stat(line)
    call Add_Stat('Mails without errors',        total.ok)
    call Add_Stat()
    call Add_Stat()
    call Add_Stat('   'copies('=', 30))
    call Add_Stat('Total mails processed',    system.stat.processed)
    call Add_Stat('Total kbytes routed',        system.stat.size)
    call Add_Stat()
    call Add_Stat('Times program used',            system.stat.ucnt)
    call Add_Stat()
    call Add_Stat()

    tmp        = system.statistics
    desc    = ''

    do while tmp~=''
        parse var tmp name tmp
        if name='' then iterate

        desc    = desc || d2h(system.stat.name)
    end

    desc    = desc d2x(hash(desc))

    MM_WriteStem        system.prg.stats 'statistic'
    call delay(25)
    MM_SetFileNote    system.prg.stats 'desc'

return



                /********** Config related routines **********/




Add_AllowEncoded: procedure Expose cpl. domain. system.

    arg dmn, mode, var, patterns

    do while patterns~=''
        parse var patterns ptrn patterns
        if strip(ptrn)='' then iterate

        call Add_Cfg_Stem(var'.encoded.'mode, Replace(ptrn, '#?', '*'))
    end

    domain.dmn.fkt.allowenc    = 1

return


Add_Cfg: procedure Expose cpl. domain. remap. system.

    parse arg var, val, add, force
    upper var

    if force~=1 & val=0    then return

    if datatype(val, 'N') & add=''    then    q        = ''
    else                                                                    q        = "'"

    line    = var'='q || translate(compress(val, '000A0D'x), 'FEFF'x, '2227'x) || q || add

    MM_AddToStem 'cpl' 'line'

    interpret line

return


Add_Cfg_Stem: procedure Expose cpl. domain. remap. system.

    parse arg stem, value
    upper stem

    MM_AddToStem stem 'value'

    if find(cpl.stems, stem)=0 then cpl.stems = cpl.stems stem

return


Add_Full_Pattern: procedure Expose cfg. cpl. n system.

    parse arg type, args

    call Parse_Cfg_Args(upper(args), 'FROM_PATTERN/A,FROMADDR_PATTERN/A,TO_PATTERN/A,TOADDR_PATTERN/A,SUBJ_PATTERN/A', '#'type, l)

    args    = ''
    uargs    = ''
    found = find('EXCLUDE KILL TWIT', type)>0
    key_l    = n+1

    do n=n+1 to cfg.count-1
        call Parse_Cfg_Line(n)

        if key=''    then iterate

        if key='ARGUMENTS' then
            if type='EXCLUDE'    then call Quit(15, 'You must not use "Arguments" for #EXCLUDE at line' l'!!!')
            else found    = 1
        else
            do
                n            = n-1
                args    = ''
                uargs    = ''
            end

        leave
    end

    if ~found then call Quit(15, 'You have to set "Arguments" for #'type 'at line' key_l'!!!')

    tmp    = 'system.ptrn.'type'.'

    call Add_Cfg_Stem(tmp'from',             Replace(cfg.prm.from_pattern,            '#?', '*'))
    call Add_Cfg_Stem(tmp'fromaddr',    Replace(cfg.prm.fromaddr_pattern, '#?', '*'))
    call Add_Cfg_Stem(tmp'to',                Replace(cfg.prm.to_pattern,                '#?', '*'))
    call Add_Cfg_Stem(tmp'toaddr',        Replace(cfg.prm.toaddr_pattern,        '#?', '*'))
    call Add_Cfg_Stem(tmp'subj',            Replace(cfg.prm.subj_pattern,            '#?', '*'))

    select
        when type='EXCLUDE'    then call Add_Cfg_Stem(tmp'mode', '*')
        when type='EXECUTE'    then call Add_Cfg_Stem(tmp'mode', args)
        when type='FORWARD'    then call Get_ForwardDatas(tmp, args, '#FORWARD-"Arguments"', l)

        otherwise
            do
                if args~=''    then call Parse_Cfg_Args(args, 'BOUNCE/S,MOVE/S', '#'type'-"Arguments"', l)
                call Add_Cfg_Stem(tmp'mode', '*' uargs)
            end
    end

    system.fkt.fp.type    = 1
return


Add_Matrix: procedure Expose cpl. system.

    parse arg areaname, addr, pth

    tmp     = 'system.mtrx.'

    call Add_Cfg_Stem(tmp'area',                                    areaname)
    call Add_Cfg_Stem(tmp'addr',                                    addr)
    call Add_Cfg(tmp'path.'Make_Valid(areaname),    pth)

    system.mtrx.count    = system.mtrx.area.count
return


Add_Pattern: procedure Expose cpl. system.

    parse arg type, stem, pt md, l
    upper            type    stem    pt
    pt    = strip(pt)
    md    = strip(md)

    if find('EXECUTE FORWARD', type)=0    then md = upper(md)
    if type='EXCLUDE'    | md=''                     then md = '*'

    tmp    = 'system.'type'.'stem'.'

    call Add_Cfg_Stem(tmp'ptrn',    Replace(pt, '#?', '*'))

    select
        when type='EXCLUDE'    then call Add_Cfg_Stem(tmp'mode', md)
        when type='EXECUTE'    then call Add_Cfg_Stem(tmp'mode', md)
        when type='FORWARD'    then call Get_ForwardDatas(tmp, md, '#FORWARD', l)
        when type='ROBOT'        then nop

        otherwise
            do
                if md~='*' then call Parse_Cfg_Args(md, 'BOUNCE/S,MOVE/S', '#'type, l)
                call Add_Cfg_Stem(tmp'mode', md)
            end
    end

    system.fkt.np.type    = 1
return


Add_Script: procedure Expose script.

    parse arg line

    MM_AddToStem 'script' 'line'

return


Analyse_Remap: procedure Expose cfg. cpl. remap. system.

    parse arg . '#REMAP' type ., n, l, args
    if args~='' then call Quit(15, 'Too many arguments "'args'" for "#REMAP" at line' l'!')

    key        = ''    ; tmp.    = ''
    key.  = 0        ; line    = l
     rarg    = 'Requiered arguments missing for'

    tmp.addr.new.a.count    = 0    ; tmp.addinfo    = 0
    tmp.addr.new.d.count    = 0    ; tmp.reply        = 0

    do n=n+1 to cfg.count-1
        call Parse_Cfg_Line(n)

        select
            when key=''                        then iterate
            when left(key, 1)='#' then leave

            when find('NAME ADDRESS', key)>0    then
                do
                    call Parse_Cfg_Args(Replace(args, '*', '#?'), 'OLD/K,NEW/K', key, l)

                    if cfg.prm.old='' & cfg.prm.new=''    then call Quit(15, rarg '"#REMAP' key'" at line' l'!')
                    if key.key then call Quit(15, 'Multiple "'key'"-lines for #REMAP'type 'at line' l 'are not allowed!')

                    key.key    = 1

                    if key='ADDRESS' then
                        do
                            key    = 'ADDR'

                            if cfg.prm.old~='' & pos('*', cfg.prm.old)=0 & pos('?', cfg.prm.old)=0 &,
                                Check_Addr(cfg.prm.old, 'NOADJ')='' then
                                    call Quit(15, 'Invalid address "'cfg.prm.old'" for "#REMAP' key'" at line' l'!')

                            do while cfg.prm.new~=''
                                parse var cfg.prm.new address cfg.prm.new

                                if pos('*', address)=0 & pos('?', address)=0 & Check_Addr(address, 'NOADJ')='' then
                                    call Quit(15, 'Invalid address "'address'" for "#REMAP' key'" at line' l'!')

                                dmn        = Get_AddrDomain(address)
                                stem    = 'tmp.addr.new.'

                                MM_AddToStem stem'a' 'address'
                                MM_AddToStem stem'd' 'dmn'
                            end
                        end

                    tmp.key.old    = cfg.prm.old
                    tmp.key.new    = cfg.prm.new
                end

            when key='FLAGS' then
                do
                    call Parse_Cfg_Args(args, 'FLAGS/A', key, l)

                    tmp.key    = cfg.prm.flags
                end

            when find('ADDINFO REPLY', key)>0    then
                if args='' then
                    if type='FROM' & key='REPLY' then call Quit(15, 'Invalid option "'Reply'" for #REMAPFROM at line' l'!')
                    else tmp.key    = 1
                else call Quit(15, 'Too many arguments "'args'" for "#REMAP' key'" at line' l'!')

            otherwise call Quit(11, cfg.err l': Unknown keyword' key)
        end
    end

    if Remap_GetMode(tmp.addr.old, tmp.addr.new.a.count, tmp.name.old, tmp.name.new)=0 then
        call Quit(15, 'Wrong number of arguments for "#REMAP" begining at line' line'!')

    stem    = 'remap.'type'.'remap.type.count'.'

    if tmp.addr.old~=''    then    call Add_Cfg(stem'addr.old',    tmp.addr.old)
    do m=0 to tmp.addr.new.a.count-1
        call Add_Cfg(stem'addr.new.'tmp.addr.new.d.m,                 tmp.addr.new.a.m)
    end

    if tmp.name.old~=''    then    call Add_Cfg(stem'name.old',    Replace(tmp.name.old, '#?', '*'))
    if tmp.name.new~=''    then    call Add_Cfg(stem'name.new',    tmp.name.new)

    if tmp.flags~=''        then    call Add_Cfg(stem'flags',            tmp.flags)

    call Add_Cfg(stem'addinfo',    tmp.addinfo)
    call Add_Cfg(stem'reply',        tmp.reply)

    remap.type.count    = remap.type.count+1

return n-1


Check_MM_Cfg:

    MM_SearchInStem 'cfg'         'domain' '?#DOMAIN#?' 'NUM'
    MM_GetAreas            'matrix'    'MAIL'

    system.singlemail = matrix.count=2 & words(system.alldomains)>=2

    if ~system.singlemail & matrix.count<domain.count+1 then
        call Quit(23, 'Incorrect number of #MAILAREAS!!! Please read the docs!')

    if system.singlemail then call Add_Cfg('system.singlemail', 1)

    call Add_Cfg('system.mailareas', matrix.count)

    system.bad_point    = '9999:9999/9999.9999@BadNet'
    if find(system.addresses, upper(system.bad_point))=0 then
        call Quit(24, '"#ADDRESS' system.bad_point'" not defined! => See docs 3.5!')

    system.bad_node    = '9999:9999/9999.0@BadNet'
    MM_GetNodeInfo system.bad_node 'tmp'
    if RC~=0 then call Quit(25, '"#NODE' system.bad_node'" not defined! => See docs 3.6!')

return


Compile_Cfg: procedure Expose domain. remap. system.

    call Log(' Reading & compiling config...')

    MM_ReadStem system.prg.cfg 'cfg'
    if rc>0 then call Quit(21, system.prg.cfg)

    cpl.                            = 0
    cpl.stems                    = ''

    call Add_Cfg(' DOMAIN.', 0,, 1);    call Add_Cfg(' REMAP.', '',, 1)
  call Add_Cfg(' LOG', 'LOG');            call Add_Cfg(' SIZE', 'SIZE')

    call Check_MM_Cfg

    cfg.err                        = 'Line'
    cfg.texts                    = '#SUBJ_BOUNCE_CROSSNET #SUBJ_BOUNCE_ENCODED #SUBJ_BOUNCE_KILL',
                                            '#SUBJ_BOUNCE_TWIT #SUBJ_BOUNCE_UNKNDST #SUBJ_CROSSNET_TODST',
                                            '#SUBJ_CROSSNET_TOSRC #SUBJ_FATT_TOSRC #SUBJ_LOOP_TODST',
                                            '#SUBJ_LOOP_TOLINK #SUBJ_LOOP_TOSRC #SUBJ_REMAP_REPLY #SUBJ_RRR',
                                            '#SUBJ_UNKNSRC #SUBJ_NOFATT #SUBJ_BOUNCE_SPLITENCODED',
                                            '#SUBJ_FATT_NOTFOUND'

    rep_addr                    = 0
    remap.from.count    = 0
    remap.to.count        = 0
    system.domains        = ''
    system.vdomains        = ''
    system.languages    = ''

    do n=0 to cfg.count-1
        call Parse_Cfg_Line(n)

        select
            when key=''                    then iterate

            when key='#DEBUG'        then call Add_Cfg('system.debug', 1)

            when key='#DOMAIN'    then
                do
                    call Parse_Cfg_Args(args, 'DOMAIN/A,ZONES,ADJUST/S', key, l)

                    dmn            = Make_Valid(cfg.prm.domain)
                    udmn        = upper(cfg.prm.domain)
                    zns            = strip(translate(cfg.prm.zones, ' ', ','))
                    var_dmn    = 'domain.'dmn

                    if index(system.addresses, '@'udmn)=0 then
                        call Quit(11, cfg.err l': Unknown domain "'cfg.prm.domain'"!')

                    if find(system.vdomains, dmn)>0 then
                        call Quit(11, cfg.err l': Domain "'cfg.prm.domain'" was already used in another #DOMAIN-statement!')

                    system.domains    = system.domains    cfg.prm.domain
                    system.vdomains    = system.vdomains    dmn

                    call Add_Cfg(' 'dmn, dmn)
                    call Add_Cfg(var_dmn'.zones', zns)

                    if zns~='' & cfg.prm.adjust then call Add_Cfg(var_dmn'.adjust', 1)
                end

            when key='ALLOWENCODEDFROM' then call Add_AllowEncoded(dmn, 'From', var_dmn, uargs)
            when key='ALLOWENCODEDTO'     then call Add_AllowEncoded(dmn, 'To',   var_dmn, uargs)

            when key='BOUNCE'    then
                do
                    call Parse_Cfg_Args(args, 'CROSSNET/S,UNKNDST/S,WRONGADDR/S', key, l)
                    call Add_Cfg(var_dmn'.bounce.crossnet',        cfg.prm.crossnet)
                    call Add_Cfg(var_dmn'.bounce.unkndst',      cfg.prm.unkndst)
                    call Add_Cfg(var_dmn'.bounce.wrongaddr',    cfg.prm.wrongaddr)
                end

            when key='CHECKENCODED'    then
                do
                    call Parse_Cfg_Args(args, 'SIZE/A/N,BOUNCE/S,MOVE/S,SPLIT/S', key, l)

                    tmp    = ''
                    if cfg.prm.bounce            then    tmp    =    tmp 'BOUNCE'
                    if cfg.prm.move                then    tmp    = tmp 'MOVE'
                    if cfg.prm.split            then    tmp    = tmp 'SPLIT'
                    if cfg.prm.size<1024    then    call Quit(13, cfg.err l':' key '- Value too low ('size')')

                    call Add_Cfg(var_dmn'.encoded.size', cfg.prm.size)
                    call Add_Cfg(var_dmn'.encoded.mode', strip(tmp))
                end

            when key='CHECKFATT' then
                do
                    call Parse_Cfg_Args(args, 'ADJUST/S,MOVEBAD/S,NOTIFY/S,PUTONHOLD/S,MOVEOWN/K', key, l)

                    tmp        = cfg.err l': "CheckFATT" - too many parameters'

                    select
                        when cfg.prm.putonhold & cfg.prm.movebad    then    call Quit(11, tmp '(Only "PutOnHold" or "MoveBad")!')
                        when cfg.prm.notify & cfg.prm.putonhold        then    call Quit(11, tmp '("PutOnHold" includes "Notify")!')
                        when cfg.prm.movebad                                            then    call Add_Cfg(var_dmn'.fatt.bad',        1)
                        when cfg.prm.putonhold                                        then    call Add_Cfg(var_dmn'.fatt.hold',        1)
                        otherwise                                                                                call Add_Cfg(var_dmn'.fatt.delete', 1)
                    end

                    call Add_Cfg(var_dmn'.fatt.notify', cfg.prm.putonhold | cfg.prm.notify)
                    call Add_Cfg(var_dmn'.fatt.adjust',    cfg.prm.adjust)

                    call Add_Cfg(var_dmn'.fatt.ownpath', path(cfg.prm.moveown))

                    if cfg.prm.moveown~=''    then
                        if ~exists(cfg.prm.moveown)    then    call Quit(11, cfg.err l': "'cfg.prm.moveown'" does not exist!')

                    call Add_Cfg(var_dmn'.fatt', 1)
                end

            when key='CHECKLOOP'        then call Add_Cfg(var_dmn'.loop', 1)

            when key='DELETE' then
                do
                    call Parse_Cfg_Args(args, 'EMPTY/S,GOOD/S,OWN/S', key, l)
                    call Add_Cfg(var_dmn'.delete.empty',    cfg.prm.empty)
                    call Add_Cfg(var_dmn'.delete.good',        cfg.prm.good)
                    call Add_Cfg(var_dmn'.delete.own',        cfg.prm.own)
                end

            when key='EXPORT'             then call Add_Cfg(var_dmn'.export',    1)

            when key='FROMADDR'            then
                do
                    tmp    = Check_Addr(args, 'NOADJ')

                    if tmp~=args | find(system.addresses, upper(tmp))=0 | Get_AddrDomain(tmp)~=dmn then
                        call Quit(11, cfg.err l': Invalid address "'args'"!')

                    call Add_Cfg(var_dmn'.replyaddr', tmp)
                    rep_addr    = rep_addr+1
                end

            when key='LOGFILE'            then call Add_Cfg(var_dmn'.log.file',    args)

            when key='LOGMODES'            then
                do
                    call Parse_Cfg_Args(args, 'ALL/S,BAD/S,FLAGS/S,SUBJECT/S,SIZE/S,ROUTING/S,VIAALL/S,VIAADDR/S', key, l)

                    if cfg.prm.all & cfg.prm.bad    then
                        call Quit(11, cfg.err l': "LogModes" - too many parameters (only ALL or BAD)')

                    if cfg.prm.viaall & cfg.prm.viaaddr then
                        call Quit(11, cfg.err l': "LogModes" - too many parameters (only "ViaAddr" or "ViaAll")')

                    call Add_Cfg(var_dmn'.log.all',                cfg.prm.all)
                    call Add_Cfg(var_dmn'.log.bad',                cfg.prm.bad)
                    call Add_Cfg(var_dmn'.log.flags',            cfg.prm.flags)
                    call Add_Cfg(var_dmn'.log.subj',            cfg.prm.subject)
                    call Add_Cfg(var_dmn'.log.size',            cfg.prm.size)
                    call Add_Cfg(var_dmn'.log.routing',        cfg.prm.routing)
                    call Add_Cfg(var_dmn'.log.via.all',        cfg.prm.viaall)
                    call Add_Cfg(var_dmn'.log.via.addr',    cfg.prm.viaaddr)
                end

            when key='RETURNRECEIPT'    then
                do
                    call Parse_Cfg_Args(args, 'POINTS/S,SYSTEM/S', key, l)
                    call Add_Cfg(var_dmn'.rrr.points', cfg.prm.points)
                    call Add_Cfg(var_dmn'.rrr.system', cfg.prm.system)
                end

            when key='#BADAREA'            then
                do
                    MM_GetAreaInfo uargs 'bad'
                    if RC=0                         then call Add_Cfg('system.badarea',        uargs)
                    if bad.type~='MAIL' then call Quit(11, args 'is not a #MAILAREA!!!')

                    if upper(bad.addr)~=upper(system.bad_point) then
                        call Quit(26, '#BADAREA not correct defined! "'bad.addr'" used instead of "'system.bad_point'"! => See docs 3.8!')

                    call Add_Cfg('system.badaddr',        bad.addr)
                    call Add_Cfg('system.baddomain',    Get_AddrDomain(bad.addr))
                    call Add_Cfg('system.badpath',        path(bad.path))
                end

            when key='#COMPILENL'            then
                if args~=''                            then call Add_Cfg('system.cplnl',                 args)
                else call Quit(13, 'No command set for #COMPILENL at line' l'!!!')

            when key='#EXCLUDEADDR'        then call Add_Pattern('EXCLUDE', 'ADDR', uargs, l)
            when key='#EXCLUDENAME'        then call Add_Pattern('EXCLUDE', 'NAME', uargs, l)
            when key='#EXCLUDESUBJ'        then call Add_Pattern('EXCLUDE', 'SUBJ', uargs, l)
            when key='#EXCLUDE'                then call Add_Full_Pattern('EXCLUDE',    uargs, l)

            when key='#EXECUTEADDR'        then call Add_Pattern('EXECUTE', 'ADDR', args, l)
            when key='#EXECUTENAME'        then call Add_Pattern('EXECUTE', 'NAME', args, l)
            when key='#EXECUTESUBJ'        then call Add_Pattern('EXECUTE', 'SUBJ', args, l)
            when key='#EXECUTE'                then call Add_Full_Pattern('EXECUTE',    args, l)

            when key='#FORWARDADDR'        then call Add_Pattern('FORWARD', 'ADDR', args, l)
            when key='#FORWARDNAME'        then call Add_Pattern('FORWARD', 'NAME', args, l)
            when key='#FORWARDSUBJ'        then call Add_Pattern('FORWARD', 'SUBJ', args, l)
            when key='#FORWARD'                then call Add_Full_Pattern('FORWARD',    args, l)

            when key='#KILLADDR'            then call Add_Pattern('KILL', 'ADDR', uargs, l)
            when key='#KILLNAME'            then call Add_Pattern('KILL', 'NAME', uargs, l)
            when key='#KILLSUBJ'            then call Add_Pattern('KILL', 'SUBJ', uargs, l)
            when key='#KILL'                    then call Add_Full_Pattern('KILL',        uargs, l)

            when key='#LANGUAGE'            then
                do
                    call Parse_Cfg_Args(uargs, 'LANG_EXT/A,PATTERN/A', key, l)

                    if cfg.prm.lang_ext='DEFAULT'    then call Quit(12, 'Invalid #LANGUAGE DEFAULT at line' l)

                    if cfg.prm.lang_ext~=Make_Valid(cfg.prm.lang_ext) then
                        call Quit(12, errortext(35) 'in language' lang_ext 'at line' l)

                    call Add_Cfg_Stem('system.lang.ptrn.'cfg.prm.lang_ext, Replace(cfg.prm.pattern, '#?', '*'))

                    if find(system.languages, cfg.prm.lang_ext)>0 then break

                    system.languages    = system.languages        cfg.prm.lang_ext
                    call Add_Cfg_Stem('system.lang.known',    cfg.prm.lang_ext)
                end

            when key='#MAILROBOT'            then call Add_Pattern('ROBOT', 'NAME', uargs, l)

            when key='#NOSTATISTICS'    then call Add_Cfg('system.nostats', 1)

            when key='#TWITADDR'            then call Add_Pattern('TWIT', 'ADDR', uargs)
            when key='#TWITNAME'            then call Add_Pattern('TWIT', 'NAME', uargs)
            when key='#TWITSUBJ'            then call Add_Pattern('TWIT', 'SUBJ', uargs)
            when key='#TWIT'                    then call Add_Full_Pattern('TWIT',    uargs)

            when find('#REMAPFROM #REMAPTO', key)>0 then n    = Analyse_Remap(key, n, l, args)

            when key='#TASKPRI'                then
                do
                    if ~datatype(args, 'N') | args<-5 | args>5 then call Quit(12, 'Invalid #TASKPRI at line' l)

                    call pragma('p', args)
                    call Add_Cfg('system.taskpri', args)
                end

            when key='#SHOWNL'                then call Add_Cfg('system.shownl', args)
            when key='#STATISTICS'        then nop

            otherwise call Quit(11, cfg.err l': Unknown keyword' key)
        end
    end

    if system.badarea=0 | find(system.vdomains, Get_AddrDomain(bad.addr))>0 then
        call Quit(15, '#BADAREA not correctly configured!')

    call Add_Cfg('remap.from.count',    remap.from.count,,    1)
    call Add_Cfg('remap.to.count',        remap.to.count,,        1)
    call Add_Cfg('system.domains',         strip(system.domains  ))
    call Add_Cfg('system.vdomains',        strip(system.vdomains ))
    call Add_Cfg('system.languages',    strip(system.languages))

    tmp    = system.vdomains

    do while tmp~=''
        parse var tmp dmn tmp
        if strip(dmn)='' then iterate

        if strip(domain.dmn.encoded.form, 'b', '0 ')~='' then
            call Add_Cfg('domain.'dmn'.encoded.from', strip(domain.dmn.encoded.from))

        if strip(domain.dmn.encoded.to,        'b', '0 ')~='' then
            call Add_Cfg('domain.'dmn'.encoded.to',        strip(domain.dmn.encoded.to  ))

        call Add_Cfg('domain.'dmn'.fkt.allowenc', domain.dmn.fkt.allowenc)
        call Add_Cfg('domain.'dmn'.fkt.rf',                domain.dmn.fkt.rf)
        call Add_Cfg('domain.'dmn'.fkt.rt',                domain.dmn.fkt.rt)
    end

    fkt.0 = 'EXCLUDE'; fkt.1 = 'EXECUTE'; fkt.2 = 'FORWARD'; fkt.3 = 'KILL'; fkt.4 = 'TWIT'; fkt.count = 5

    do n=0 to fkt.count-1
        tst    = fkt.n

        call Add_Cfg('system.fkt.fp.'tst,    system.fkt.fp.tst)
        call Add_Cfg('system.fkt.np.'tst,    system.fkt.np.tst)
        call Add_Cfg('system.fkt.'tst,        system.fkt.fp.tst | system.fkt.np.tst)
    end

    if ~system.singlemail then
        do n=0 to matrix.count-1
            if upper(matrix.n)=system.badarea then iterate

            MM_GetAreaInfo matrix.n 'tmp'
            dmn = Get_AddrDomain(tmp.addr)

            if domain.dmn.replyaddr=0 then call Add_Cfg('domain.'dmn'.replyaddr', tmp.addr)
        end
    else
        if rep_addr~=domain.count then call Quit(11, 'You have to set one FromAddr per #DOMAIN!!!')


    call Get_MailAreas(system.vdomains)

    tmp = system.languages

    if Read_Texts() then call Quit(12, 'No default Misc-texts!!!')

    do while tmp~=''
        parse var tmp lang tmp

        call Read_Texts(lang)
    end
                                                                                                                                                                                                                                                                                                                                interpret '6B6E6F203D2027554E524547273B7265673D273D3D3D20554E52454749535445524544204556414C554154494F4E2056455253494F4E203D3D3D2020506C6561736520726567697374657221273B6966206F70656E28696E2C73797374656D2E707267'x||'2E706678276B6579272C27722729207468656E20646F3B6B65793D72656164636828696E2C31303234293B63616C6C20636C6F736528696E293B6C696E653D27273B646F207768696C65206B65797E3D27273B706172736520766172206B6579203120'x||'636861722032206B65793B6C696E653D6C696E657C7C6332782863686172293B656E643B6C696E653D72657665727365286C696E65293B706172736520766172206C696E6520312068617368203235206B65793B686173683D6232632868617368293B'x||'746D703D27273B646F207768696C65206B65797E3D27273B706172736520766172206B6579203120696478203220636861722037202E2039206B65793B6164643D64327828636861722F6964782F686173682D33293B746D703D746D707C7C6164643B'x||,
                                                                                                                                                                                                                                                                                                                                '656E643B70617273652076616C75652078326328746D702920776974682070676D206E7220757365723B757365723D73747269702875736572293B69662073797374656D2E7072672E6E616D653D70676D20262073797374656D2E7379736F703D7573'x||'6572207468656E20646F3B6E723D6E722B303B6B6E6F3D2723276E723B7265673D275265676973746572656420746F3A272075736572202728276B6E6F2729273B656E643B656E643B63616C6C204164645F436667282773797374656D2E7072672E73'x||'74617465272C633278286B6E6F292C277827293B63616C6C204164645F436667282773797374656D2E7072672E696E666F272C63327828726567292C277827293B63616C6C204164645F436667282773797374656D2E7072672E666964272C63327828'x||'73797374656D2E7072672E696427202773797374656D2E7072672E7374617465292C277827293B63616C6C204164645F436667282773797374656D2E7072672E746561726C696E65272C63327828272D2D2D272073797374656D2E7072672E66696427'x||'202773797374656D2E7072672E6372292C27782729'x
    drop dmn lang mode ptrn size tmp

    do until cpl.stems=''
        parse var cpl.stems stem cpl.stems
        stem = strip(stem)
        if stem='' then iterate

        code    = "do n=0 to" stem".count-1; call Add_Cfg('"stem".'n," stem".n); end;",
                        "call Add_Cfg('"stem".count'," stem".count)"

        interpret code
    end

    MM_SortStem 'cpl'

    MM_ReadStem            system.prg.script 'script'
    MM_SearchInStem    'script' 'tmp' 'Cfg:' 'NUM'

    if tmp.count=0 then call Quit(22, system.prg.script 'was modified or not found! Please read the docs!')

    script.count    = tmp.0+1

    call Add_Script()

    line    = '9'x

    do n=0 to cpl.count-1
        tmp    = strip(cpl.n)

        if length(line tmp)>=1024    then
            do
                call Add_Script(strip(line, 't', '; '))
                line    = '9'x
            end

        line    = line || tmp';'
    end

    if length(line)>2 then call Add_Script(strip(line, 't', '; '))

    call Add_Script()
    call Add_Script('return')
    call Add_Script()

    MM_WriteStem    system.prg.script    'script'
    MM_CRCFile        system.prg.cfg         'cfg_crc'
    MM_CRCFile        system.prg.script    'scr_crc'

    tmp = c2x(system.prg.ver) cfg_crc scr_crc

    MM_SetFileNote    system.prg.script    'tmp'

return


Get_Cfg_Arg: procedure Expose args cfg. system.

  arg keyword, mode, old

    uargs    = upper(args)
    p            = find(uargs, keyword)

    if p=0    then
        do
            p = pos(' 'keyword'=', ' 'uargs)

            if p>0 then    args    = overlay(' ', args, p+length(keyword))

      p = find(upper(args), keyword)
        end

    system.cmdopt.keyword    = p>0

    select
        when mode=0    then
            if p>0 then
                do
                    ret        = 1
                    args    = delword(args, p, 1)
                end
            else ret    = old

        when mode=1 then
            if p>0 then
                do
                    left    = subword(args, 1, p-1)
                    rest    = subword(args, p+1)

                    if left(rest, 1)='"' then    parse var rest . '"'    ret '"'    rest
                    else                                            parse var rest                ret            rest

                    args    = strip(left strip(rest))
                end
            else ret    = old

        when mode=2 then
            do
                if left(args, 1)='"'    then    parse var args . '"'    ret '"'    args
                else                                                parse var args                ret         args

                if strip(ret)=''            then    ret = old
            end

        otherwise exit 99
    end

    args    = strip(args)
    ret        = strip(ret, 'b', '" ')

return ret


Get_ForwardDatas: procedure Expose cfg. cpl. system.

    parse arg stem, args, key, l

    call Parse_Cfg_Args(args, 'AREA/K/A,TO/A/K,TOADDR/K,SUBJ/K/A,FLAGS/K/M,DELORIGMSG/S', key, l)

    err    = 'in #FORWARD at line' l'!!!'

    if cfg.prm.area~='%ma'    then
        do
            MM_GetAreaInfo cfg.prm.area 'data'
            if RC~=0    then        call Quit(15, 'Unknown area "'cfg.prm.area'"' err)
        end
    else data.type = 'MAIL'

    if data.type='MAIL'    then
        do
            tmp = Check_Addr(cfg.prm.toaddr, 'NOADJ')
            if tmp=''    then        call Quit(15, 'Invalid address "'cfg.prm.toaddr'"' err)
        end

    call Add_Cfg_Stem(stem'mode',    cfg.prm.area'¡'cfg.prm.to'¡'cfg.prm.toaddr'¡'cfg.prm.subj'¡' ||,
                                        cfg.prm.flags'¡'cfg.prm.delorigmsg)

return


Get_MailAreas: procedure Expose cpl. system.

    arg domains

    MM_GetAreas 'tmp' 'MAIL'

    if tmp.count~=system.mailareas then call Quit(11, 'Incorrect number of #MAILAREAS!!!')

    do n=0 to tmp.count-1
        MM_GetAreaInfo tmp.n 'info'

        if find(domains, Get_AddrDomain(info.addr))=0    then iterate
        if pos(':', info.altpath)=0                                        then info.altpath    = info.path

        call Add_Matrix(tmp.n, info.addr, path(info.altpath))
    end

    call Add_Cfg('system.mtrx.count',            system.mtrx.count)
    call Add_Cfg('system.mailareas.all',    tmp.count)                                                                                                                                                                                                                                                                                                                                                                        ; if index('54494C4F2057494E4B4C45523B'x, upper(system.sysop))>0 then system.mtrx.count = 0

return


Parse_Cfg_Args: procedure Expose cfg. system.

    parse arg args, tpl, cfgkey, l

    args    = strip(translate(args, '  ', '9'x'='))

    if args=''    then call Quit(15, 'No arguments given for' cfgkey 'at line' l'!!!')

    pk        = pos('/K', tpl)
    ps        = pos('/S', tpl)

    select
        when pk=0    & ps=0    then    p    = 0
        when pk=0 & ps>0    then  p    = ps
        when ps=0 & pk>0    then    p    = pk
        otherwise                                p    = min(pk, ps)
    end

    p            = lastpos(',', left(tpl, p))
    tpl        = substr(tpl',', p+1) || left(tpl, max(p-1, 0))

    do while tpl~=''
        parse var tpl template ',' tpl
        parse var template keyword '/' .

        bool    = pos('/S',    template)>0
        key        = pos('/K', template)>0
        must    = pos('/A', template)>0
        num        = pos('/N', template)>0

        select
            when must then        cfg.prm.keyword    = '0'x
            when bool    then        cfg.prm.keyword    = 0
            when num    then        cfg.prm.keyword    = 0

            otherwise                    cfg.prm.keyword    = ''
        end

        if bool | key    then    mode    = ~bool
        else                mode    = 2

        cfg.prm.keyword    = Get_Cfg_Arg(keyword, mode, cfg.prm.keyword)

        if must & cfg.prm.keyword='0'x then call Quit(15, template 'for' cfgkey 'missing at line' l)

        if num & ~datatype(cfg.prm.keyword, 'N') then
            if ~must & cfg.prm.keyword='' then    cfg.prm.keyword    = 0
            else                                                                call Quit(15, 'Numeric value expected for'cfgkey template' at line' l', but is "'cfg.prm.keyword'"!!!')
    end

    if args~='' then call Quit(10, 'Unknown option(s) "'args'" for' cfgkey 'at line' l'!!!')

return


Parse_Cfg_Line:

        parse arg l
        parse value    strip(translate(cfg.l, ' ', '9'x)) with key args ';' .

        key        = upper(strip(key))
        args    = strip(args)
        uargs    = upper(args)
        l            = l+1

return


Read_Cfg: procedure Expose domain. remap. system.

    parse arg system.nocpl

    parse value statef(system.prg.script) with . size . . . . . version cfg_crc scr_crc

    if ~datatype(version, 'X') then version = ''

    MM_CRCFile system.prg.cfg 'crc'

    if (x2c(version)=system.prg.ver & crc=cfg_crc & ~system.forcecpl) | system.nocpl then
        do
            MM_CRCFile system.prg.script 'crc'

            if crc=scr_crc | system.nocpl then
                do
                    call Log(' Reading config...',, 3)
                    call Cfg
                    call Log(' 'system.prg.info,, 3)
                    return
                end
        end

    call Compile_Cfg
    call Log(' 'system.prg.info,, 3)

return


Read_Texts: procedure Expose cfg. cpl. system.

    arg lang .

    file = Read_File('Misc', lang)

    if lang='' then lang = 'DEFAULT'
    else
        if pos('.'lang, upper(file))=0 then return 0

    l        = 0
    ret = file=''

    do n=0 to txt.count-1
        parse value strip(translate(txt.n, ' ', '9'x)) with key args ';' .
        key        = upper(strip(key))
        args    = strip(args)
        l            = l+1

        if key=''                                    then iterate
        if find(cfg.texts, key)=0 then call Quit(11, 'Unknown keyword "'key'" in' file 'at line' l)

        parse var key . 2 typ '_' name .

        call Add_Cfg('system.txt.'lang'.'typ'.'name, args)
    end

return ret


                                 /*** CFG ***/


Cfg:

    exit 99

return